Commit 68afb167 authored by partain's avatar partain
Browse files

[project @ 1996-05-06 11:01:29 by partain]

SLPJ 1.3 changes through 960505
parent 3990d444
......@@ -39,7 +39,10 @@ module CLabel (
needsCDecl, isReadOnly, isAsmTemp, externallyVisibleCLabel,
pprCLabel, pprCLabel_asm
pprCLabel
#if ! OMIT_NATIVE_CODEGEN
, pprCLabel_asm
#endif
#ifdef GRAN
, isSlowEntryCCodeBlock
......@@ -50,7 +53,9 @@ import Ubiq{-uitous-}
import AbsCLoop ( CtrlReturnConvention(..),
ctrlReturnConvAlg
)
#if ! OMIT_NATIVE_CODEGEN
import NcgLoop ( underscorePrefix, fmtAsmLbl )
#endif
import CStrings ( pp_cSEP )
import Id ( externallyVisibleId, cmpId_withSpecDataCon,
......@@ -314,7 +319,9 @@ duplicate declarations in generating C (see @labelSeenTE@ in
\begin{code}
-- specialised for PprAsm: saves lots of arg passing in NCG
#if ! OMIT_NATIVE_CODEGEN
pprCLabel_asm = pprCLabel (PprForAsm underscorePrefix fmtAsmLbl)
#endif
pprCLabel :: PprStyle -> CLabel -> Unpretty
......
......@@ -45,7 +45,9 @@ import Id ( idPrimRep, toplevelishId, isDataCon,
)
import Maybes ( catMaybes )
import Name ( isLocallyDefined )
#ifdef DEBUG
import PprAbsC ( pprAmode )
#endif
import PprStyle ( PprStyle(..) )
import StgSyn ( StgArg(..), StgLiveVars(..), GenStgArg(..) )
import Unpretty ( uppShow )
......
......@@ -259,9 +259,9 @@ mkCoLetNoUnboxed bind@(NonRec binder rhs) body
mkCoLetsNoUnboxed [] expr = expr
mkCoLetsNoUnboxed binds expr = foldr mkCoLetNoUnboxed expr binds
--mkCoLetrecNoUnboxed :: [(Id, CoreExpr)] -- bindings
-- -> CoreExpr -- body
-- -> CoreExpr -- result
mkCoLetrecNoUnboxed :: [(GenId (GenType a b), GenCoreExpr (GenId (GenType a b)) c d e)]
-> GenCoreExpr (GenId (GenType a b)) c d e
-> GenCoreExpr (GenId (GenType a b)) c d e
mkCoLetrecNoUnboxed [] body = body
mkCoLetrecNoUnboxed binds body
......
......@@ -16,9 +16,12 @@ import Ubiq
import DsLoop -- break dsExpr-ish loop
import HsSyn -- lots of things
hiding ( collectBinders{-also in CoreSyn-} )
import CoreSyn -- lots of things
import TcHsSyn ( TypecheckedHsBinds(..), TypecheckedHsExpr(..),
TypecheckedBind(..), TypecheckedMonoBinds(..) )
TypecheckedBind(..), TypecheckedMonoBinds(..),
TypecheckedPat(..)
)
import DsHsSyn ( collectTypedBinders, collectTypedPatBinders )
import DsMonad
......@@ -39,7 +42,7 @@ import Type ( mkTyVarTys, mkForAllTys, splitSigmaTy,
import TyVar ( tyVarSetToList, GenTyVar{-instance Eq-} )
import Util ( isIn, panic, pprTrace{-ToDo:rm-} )
import PprCore--ToDo:rm
import PprType--ToDo:rm
import PprType ( GenTyVar ) --ToDo:rm
import Usage--ToDo:rm
import Unique--ToDo:rm
......
......@@ -14,7 +14,7 @@ import DsLoop -- partly to get dsBinds, partly to chk dsExpr
import HsSyn ( HsExpr(..), HsLit(..), ArithSeqInfo(..),
Match, Qual, HsBinds, Stmt, PolyType )
import TcHsSyn ( TypecheckedHsExpr(..), TypecheckedHsBinds(..),
TypecheckedRecordBinds(..)
TypecheckedRecordBinds(..), TypecheckedPat(..)
)
import CoreSyn
......@@ -22,7 +22,8 @@ import DsMonad
import DsCCall ( dsCCall )
import DsListComp ( dsListComp )
import DsUtils ( mkAppDs, mkConDs, mkPrimDs, dsExprToAtom,
mkErrorAppDs, showForErr
mkErrorAppDs, showForErr, EquationInfo,
MatchResult
)
import Match ( matchWrapper )
......@@ -38,6 +39,7 @@ import Id ( mkTupleCon, idType, nullIdEnv, addOneToIdEnv,
)
import Literal ( mkMachInt, Literal(..) )
import MagicUFs ( MagicUnfoldingFun )
import Name ( Name{--O only-} )
import PprStyle ( PprStyle(..) )
import PprType ( GenType )
import PrelInfo ( mkTupleTy, unitTy, nilDataCon, consDataCon,
......
......@@ -10,7 +10,7 @@ import Ubiq
import DsLoop -- break dsExpr-ish loop
import HsSyn ( Qual(..), HsExpr, HsBinds )
import TcHsSyn ( TypecheckedQual(..), TypecheckedHsExpr(..) )
import TcHsSyn ( TypecheckedQual(..), TypecheckedHsExpr(..) , TypecheckedHsBinds(..) )
import DsHsSyn ( outPatType )
import CoreSyn
......
......@@ -12,7 +12,7 @@ import Ubiq
import DsLoop -- here for paranoia-checking reasons
-- and to break dsExpr/dsBinds-ish loop
import HsSyn
import HsSyn hiding ( collectBinders{-also from CoreSyn-} )
import TcHsSyn ( TypecheckedPat(..), TypecheckedMatch(..),
TypecheckedHsBinds(..), TypecheckedHsExpr(..) )
import DsHsSyn ( outPatType, collectTypedPatBinders )
......
......@@ -13,8 +13,10 @@ import DsLoop -- break match-ish and dsExpr-ish loops
import HsSyn ( HsLit(..), OutPat(..), HsExpr(..),
Match, HsBinds, Stmt, Qual, PolyType, ArithSeqInfo )
import TcHsSyn ( TypecheckedHsExpr(..) )
import CoreSyn ( CoreExpr(..) )
import TcHsSyn ( TypecheckedHsExpr(..), TypecheckedHsBinds(..),
TypecheckedPat(..)
)
import CoreSyn ( CoreExpr(..), CoreBinding(..) )
import DsMonad
import DsUtils
......
......@@ -24,6 +24,7 @@ import Bag ( emptyBag, snocBag, bagToList )
import Class ( GenClass(..){-instance NamedThing-}, GenClassOp(..) )
import CmdLineOpts ( opt_ProduceHi )
import FieldLabel ( FieldLabel{-instance NamedThing-} )
import FiniteMap ( fmToList )
import HsSyn
import Id ( idType, dataConSig, dataConFieldLabels,
dataConStrictMarks, StrictnessMark(..),
......@@ -128,15 +129,34 @@ endIface (Just if_hdl) = hPutStr if_hdl "\n" >> hClose if_hdl
\begin{code}
ifaceUsages Nothing{-no iface handle-} _ = return ()
ifaceUsages (Just if_hdl) version_info
= hPutStr if_hdl "__usages__\nFoo 1" -- a stub, obviously
ifaceUsages (Just if_hdl) usages
| null usages_list
= return ()
| otherwise
= hPutStr if_hdl "__usages__\n" >>
hPutStr if_hdl (ppShow 10000 (ppAboves (map pp_uses usages_list)))
where
usages_list = fmToList usages
pp_uses (m, (mv, versions))
= ppBesides [ppPStr m, ppSP, ppInt mv, ppPStr SLIT(" :: "),
pp_versions (fmToList versions), ppSemi]
\end{code}
\begin{code}
ifaceVersions Nothing{-no iface handle-} _ = return ()
ifaceVersions (Just if_hdl) version_info
= hPutStr if_hdl "\n__versions__\nFoo 1" -- a stub, obviously
| null version_list
= return ()
| otherwise
= hPutStr if_hdl "\n__versions__\n" >>
hPutStr if_hdl (ppShow 10000 (pp_versions version_list))
where
version_list = fmToList version_info
pp_versions nvs
= ppInterleave ppComma [ ppCat [ppPStr n, ppInt v] | (n,v) <- nvs ]
\end{code}
\begin{code}
......
......@@ -28,7 +28,7 @@ import RdrHsSyn
import HsPragmas ( noGenPragmas, noClassOpPragmas )
import SrcLoc ( mkSrcLoc2 )
import Util ( panic, assertPanic )
import Util ( mapAndUnzip, panic, assertPanic )
\end{code}
%************************************************************************
......@@ -154,7 +154,7 @@ cvFunMonoBind :: SrcFile -> [RdrMatch] -> (RdrName {-VarName-}, Bool {-InfixDefn
cvFunMonoBind sf matches
= (head srcfuns, head infixdefs, cvMatches sf False matches)
where
(srcfuns, infixdefs) = unzip (map get_mdef matches)
(srcfuns, infixdefs) = mapAndUnzip get_mdef matches
-- ToDo: Check for consistent srcfun and infixdef
get_mdef (RdrMatch_NoGuard _ sfun pat _ _) = get_pdef pat
......
......@@ -228,7 +228,8 @@ mk_inst ctxt clas mono_ty
lexIface :: String -> [IfaceToken]
lexIface str
= case str of
= _scc_ "Lexer"
case str of
[] -> []
-- whitespace and comments
......
......@@ -81,7 +81,7 @@ renameModule us input@(HsModule mod _ _ imports _ _ _ _ _ _ _ _ _ _)
-- ]}) $
findHiFiles opt_HiDirList opt_SysHiDirList >>= \ hi_files ->
newVar (emptyFM, hi_files){-init iface cache-} `thenPrimIO` \ iface_cache ->
newVar (emptyFM,emptyFM,hi_files){-init iface cache-} `thenPrimIO` \ iface_cache ->
fixIO ( \ ~(_, _, _, _, rec_occ_fm, rec_export_fn) ->
let
......@@ -196,7 +196,7 @@ renameModule us input@(HsModule mod _ _ imports _ _ _ _ _ _ _ _ _ _)
\begin{code}
{- TESTING:
pprPIface (ParsedIface m v mv usgs lcm exm ims lfx ltdm lvdm lids ldp)
pprPIface (ParsedIface m ?? v mv usgs lcm exm ims lfx ltdm lvdm lids ldp)
= ppAboves [
ppCat [ppPStr SLIT("interface"), ppPStr m, ppInt v,
case mv of { Nothing -> ppNil; Just n -> ppInt n }],
......
......@@ -28,10 +28,11 @@ import RnMonad
import ErrUtils ( addErrLoc, addShortErrLocLine )
import Name ( isLocallyDefinedName, pprSym, Name, RdrName )
import Pretty
import UniqFM ( lookupUFM )
import UniqFM ( lookupUFM, ufmToList{-ToDo:rm-} )
import UniqSet ( emptyUniqSet, unitUniqSet,
unionUniqSets, unionManyUniqSets,
UniqSet(..) )
UniqSet(..)
)
import Util ( Ord3(..), removeDups, panic )
\end{code}
......@@ -485,6 +486,7 @@ precParseExpr exp@(OpApp (NegApp e1 n) (HsVar op) e2)
precParseExpr exp@(OpApp (OpApp e11 (HsVar op1) e12) (HsVar op) e2)
= lookupFixity op `thenRn` \ (op_fix, op_prec) ->
lookupFixity op1 `thenRn` \ (op1_fix, op1_prec) ->
-- pprTrace "precParse:" (ppCat [ppr PprDebug op, ppInt op_prec, ppr PprDebug op1, ppInt op1_prec]) $
case cmp op1_prec op_prec of
LT_ -> rearrange
EQ_ -> case (op1_fix, op_fix) of
......@@ -534,6 +536,7 @@ data INFIX = INFIXL | INFIXR | INFIXN deriving Eq
lookupFixity :: RnName -> RnM_Fixes s (INFIX, Int)
lookupFixity op
= getExtraRn `thenRn` \ fixity_fm ->
-- pprTrace "lookupFixity:" (ppAboves [ppCat [pprUnique u, ppr PprDebug i_f] | (u,i_f) <- ufmToList fixity_fm]) $
case lookupUFM fixity_fm op of
Nothing -> returnRn (INFIXL, 9)
Just (InfixL _ n) -> returnRn (INFIXL, n)
......
......@@ -37,8 +37,9 @@ import Bag ( emptyBag, unitBag, consBag, snocBag,
unionBags, unionManyBags, isEmptyBag, bagToList )
import CmdLineOpts ( opt_HiSuffix, opt_SysHiSuffix )
import ErrUtils ( Error(..), Warning(..) )
import FiniteMap ( emptyFM, lookupFM, addToFM, addToFM_C, plusFM, plusFM_C, eltsFM,
fmToList, delListFromFM, sizeFM, keysFM{-ToDo:rm-}
import FiniteMap ( emptyFM, lookupFM, addToFM, addToFM_C, plusFM, eltsFM,
fmToList, delListFromFM, sizeFM, foldFM, unitFM,
plusFM_C, keysFM{-ToDo:rm-}
)
import Maybes ( maybeToBool )
import Name ( moduleNamePair, origName, isRdrLexCon, RdrName(..) )
......@@ -77,9 +78,9 @@ absolute-filename-for-that-interface.
findHiFiles :: [FilePath] -> [FilePath] -> IO (FiniteMap Module FilePath)
findHiFiles dirs sysdirs
= hPutStr stderr " findHiFiles " >>
= --hPutStr stderr " findHiFiles " >>
do_dirs emptyFM (dirs ++ sysdirs) >>= \ result ->
hPutStr stderr " done\n" >>
--hPutStr stderr " done\n" >>
return result
where
do_dirs env [] = return env
......@@ -88,7 +89,7 @@ findHiFiles dirs sysdirs
do_dirs new_env dirs
-------
do_dir env dir
= hPutStr stderr "D" >>
= --hPutStr stderr "D" >>
getDirectoryContents dir >>= \ entries ->
do_entries env entries
where
......@@ -100,7 +101,7 @@ findHiFiles dirs sysdirs
do_entry env e
= case (acceptable_hi (reverse e)) of
Nothing -> --trace ("Deemed uncool:"++e) $
hPutStr stderr "." >>
--hPutStr stderr "." >>
return env
Just mod ->
let
......@@ -108,12 +109,12 @@ findHiFiles dirs sysdirs
in
case (lookupFM env pmod) of
Nothing -> --trace ("Adding "++mod++" -> "++e) $
hPutStr stderr "!" >>
--hPutStr stderr "!" >>
return (addToFM env pmod (dir ++ '/':e))
-- ToDo: use DIR_SEP, not /
Just xx -> ( if de_dot xx /= e then trace ("Already mapped!! "++mod++" -> "++xx++"; ignoring:"++e) else id) $
hPutStr stderr "." >>
--hPutStr stderr "." >>
return env
-------
acceptable_hi rev_e -- looking at pathname *backwards*
......@@ -194,7 +195,7 @@ cachedIface want_orig_iface iface_cache mod
where
want_iface iface orig_fm
| want_orig_iface
= case lookupFM orig_fm of
= case lookupFM orig_fm mod of
Nothing -> Failed (noOrigIfaceErr mod)
Just orig_iface -> Succeeded orig_iface
| otherwise
......@@ -224,7 +225,7 @@ mergeIfaces (ParsedIface mod1 (_, files1) _ _ _ _ _ _ fixes1 tdefs1 vdefs1 idefs
where
dup_merge str ppr_dup dup1 dup2
= pprTrace "mergeIfaces:"
(ppCat [ppPStr mod, ppPStr mod1, ppStr ": dup", ppStr str, ppStr "decl",
(ppCat [ppPStr mod1, ppPStr mod2, ppStr ": dup", ppStr str, ppStr "decl",
ppr_dup dup1, ppr_dup dup2]) $
dup2
......@@ -312,14 +313,18 @@ readIface :: FilePath -> Module
-> IO (MaybeErr ParsedIface Error)
readIface file mod
= hPutStr stderr (" reading "++file) >>
= --hPutStr stderr (" reading "++file) >>
readFile file `thenPrimIO` \ read_result ->
case read_result of
Left err -> return (Failed (cannaeReadErr file err))
Right contents -> hPutStr stderr " parsing" >>
Right contents -> --hPutStr stderr " parsing" >>
let parsed = parseIface contents in
hPutStr stderr " done\n" >>
return (Succeeded (init_merge mod parsed))
--hPutStr stderr " done\n" >>
return (
case parsed of
Failed _ -> parsed
Succeeded p -> Succeeded (init_merge mod p)
)
where
init_merge this (ParsedIface mod _ v sv us vs exps insts fixes tdefs vdefs idefs prags)
= ParsedIface mod (False, unitBag this) v sv us vs exps insts fixes tdefs vdefs idefs prags
......@@ -374,7 +379,7 @@ rnIfaces iface_cache imp_mods us
-- finalize what we want to say we learned about the
-- things we used
finalIfaceInfo iface_cache if_final_env if_instdecls {-all_imports_used imp_mods-} >>=
finalIfaceInfo iface_cache modname if_final_env if_instdecls {-all_imports_used imp_mods-} >>=
\ usage_stuff@(usage_info, version_info, instance_mods) ->
return (HsModule modname iface_version exports imports fixities
......@@ -779,6 +784,7 @@ rnIfaceInst (InstSig _ _ _ inst_decl) = rnInstDecl inst_decl
\begin{code}
finalIfaceInfo ::
IfaceCache -- iface cache
-> Module -- this module's name
-> RnEnv
-> [RenamedInstDecl]
-- -> [RnName] -- all imported names required
......@@ -787,14 +793,47 @@ finalIfaceInfo ::
VersionsMap, -- info about version numbers
[Module]) -- special instance modules
finalIfaceInfo iface_cache if_final_env@((qual, unqual, tc_qual, tc_unqual), stack) if_instdecls
finalIfaceInfo iface_cache modname if_final_env@((qual, unqual, tc_qual, tc_unqual), stack) if_instdecls
=
pprTrace "usageIf:qual:" (ppCat [ppBesides[ppPStr m,ppChar '.',ppPStr n] | (n,m) <- keysFM qual]) $
-- pprTrace "usageIf:unqual:" (ppCat (map ppPStr (keysFM unqual))) $
pprTrace "usageIf:tc_qual:" (ppCat [ppBesides[ppPStr m,ppChar '.',ppPStr n] | (n,m) <- keysFM tc_qual]) $
-- pprTrace "usageIf:tc_unqual:" (ppCat (map ppPStr (keysFM tc_unqual))) $
let
val_stuff@(val_usages, val_versions)
= foldFM process_item (emptyFM, emptyFM){-init-} qual
return (emptyFM, emptyFM, [])
(all_usages, all_versions)
= foldFM process_item val_stuff{-keep going-} tc_qual
in
return (all_usages, all_versions, [])
where
process_item :: (FAST_STRING,Module) -> RnName -- RnEnv (QualNames) components
-> (UsagesMap, VersionsMap) -- input
-> (UsagesMap, VersionsMap) -- output
process_item (n,m) rn as_before@(usages, versions)
| irrelevant rn
= as_before
| m == modname -- this module => add to "versions"
= (usages, addToFM versions n 1{-stub-})
| otherwise -- from another module => add to "usages"
= (add_to_usages usages m n 1{-stub-}, versions)
irrelevant (RnConstr _ _) = True -- We don't report these in their
irrelevant (RnField _ _) = True -- own right in usages/etc.
irrelevant (RnClassOp _ _) = True
irrelevant _ = False
add_to_usages usages m n version
= addToFM usages m (
case (lookupFM usages m) of
Nothing -> -- nothing for this module yet...
(1{-stub-}, unitFM n version)
Just (mversion, mstuff) -> -- the "new" stuff will shadow the old
(mversion, addToFM mstuff n version)
)
\end{code}
......
......@@ -289,7 +289,7 @@ newGlobalName locn maybe_exp rdr
Just exp -> exp
Nothing -> exp_fn n
n = mkTopLevName uniq orig locn exp (occ_fn n)
n = mkTopLevName uniq orig locn exp (occ_fn n) -- NB: two "n"s
in
addWarnIfRn (rdr == Unqual SLIT("negate")) (negateNameWarn (rdr, locn)) `thenRn_`
addErrIfRn (isQual rdr) (qualNameErr "name in definition" (rdr, locn)) `thenRn_`
......@@ -363,6 +363,9 @@ doImportDecls iface_cache g_info us src_imps
then [{- no "import Prelude" -}]
else [ImportDecl pRELUDE False Nothing Nothing prel_loc]
prel_imps -- WDP: Just guessing on this defn... ToDo
= [ imp | imp@(ImportDecl mod _ _ _ _) <- the_imps, fromPrelude mod ]
prel_loc = mkBuiltinSrcLoc
(uniq_imps, imp_dups) = removeDups cmp_mod the_imps
......@@ -431,15 +434,16 @@ doImport iface_cache info us (ImportDecl mod qual maybe_as maybe_spec src_loc)
>>= \ (ie_vals, ie_tcs, imp_flags, errs, warns) ->
accumulate (map (checkOrigIE iface_cache) chk_ies)
>>= \ chk_errs_warns ->
accumulate (map (getFixityDecl iface_cache) (bagToList ie_vals))
let
final_vals = mapBag fst_occ b_vals `unionBags` mapBag pair_occ ie_vals
final_tcs = mapBag fst_occ b_tcs `unionBags` mapBag pair_occ ie_tcs
in
accumulate (map (getFixityDecl iface_cache) (bagToList final_vals))
>>= \ fix_maybes_errs ->
let
(chk_errs, chk_warns) = unzip chk_errs_warns
(fix_maybes, fix_errs) = unzip fix_maybes_errs
final_vals = mapBag fst_occ b_vals `unionBags` mapBag pair_occ ie_vals
final_tcs = mapBag fst_occ b_tcs `unionBags` mapBag pair_occ ie_tcs
unquals = if qual then emptyBag
else mapBag pair_as (ie_vals `unionBags` ie_tcs)
......@@ -511,16 +515,16 @@ getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) mod maybe_spec
(vals, tcs, ies_left) = do_builtin ies
getOrigIEs (ParsedIface _ _ _ _ _ exps _ _ _ _ _ _) Nothing -- import all
getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) Nothing -- import all
= (map mkAllIE (eltsFM exps), [], emptyBag)
getOrigIEs (ParsedIface _ _ _ _ _ exps _ _ _ _ _ _) (Just (True, ies)) -- import hiding
getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) (Just (True, ies)) -- import hiding
= (map mkAllIE (eltsFM exps_left), found_ies, errs)
where
(found_ies, errs) = lookupIEs exps ies
exps_left = delListFromFM exps (map (getLocalName.ie_name.fst) found_ies)
getOrigIEs (ParsedIface _ _ _ _ _ exps _ _ _ _ _ _) (Just (False, ies)) -- import these
getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) (Just (False, ies)) -- import these
= (map fst found_ies, found_ies, errs)
where
(found_ies, errs) = lookupIEs exps ies
......@@ -617,7 +621,7 @@ with_decl iface_cache n do_err do_decl
Succeeded decl -> return (do_decl decl)
getFixityDecl iface_cache rn
getFixityDecl iface_cache (_,rn)
= let
(mod, str) = moduleNamePair rn
in
......@@ -625,7 +629,7 @@ getFixityDecl iface_cache rn
case maybe_iface of
Failed err ->
return (Nothing, unitBag err)
Succeeded (ParsedIface _ _ _ _ _ _ _ fixes _ _ _ _) ->
Succeeded (ParsedIface _ _ _ _ _ _ _ _ fixes _ _ _ _) ->
case lookupFM fixes str of
Nothing -> return (Nothing, emptyBag)
Just (InfixL _ i) -> return (Just (InfixL rn i), emptyBag)
......@@ -761,7 +765,7 @@ newImportedName tycon_or_class locn maybe_exp maybe_imp rdr
(imp_flag, imp_locs) = imp_fn n
n = mkImportedName uniq rdr imp locn imp_locs exp (occ_fn n)
n = mkImportedName uniq rdr imp locn imp_locs exp (occ_fn n) -- NB: two "n"s
in
returnRn n
\end{code}
......
......@@ -89,8 +89,7 @@ core2core :: [CoreToDo] -- spec of what core-to-core passes to do
SpecialiseData) -- specialisation data
core2core core_todos module_name ppr_style us local_tycons tycon_specs binds
= _scc_ "Core2Core"
if null core_todos then -- very rare, I suspect...
= if null core_todos then -- very rare, I suspect...
-- well, we still must do some renumbering
return (
(substCoreBindings nullIdEnv nullTyVarEnv binds us,
......
......@@ -53,8 +53,7 @@ stg2stg :: [StgToDo] -- spec of what stg-to-stg passes to do
[CostCentre])) -- "extern" cost-centres
stg2stg stg_todos module_name ppr_style us binds
= _scc_ "Stg2Stg"
case (splitUniqSupply us) of { (us4now, us4later) ->
= case (splitUniqSupply us) of { (us4now, us4later) ->
(if do_verbose_stg2stg then
hPutStr stderr "VERBOSE STG-TO-STG:\n" >>
......
......@@ -48,10 +48,11 @@ module FiniteMap (
plusFM,
plusFM_C,
minusFM,
foldFM,
IF_NOT_GHC(intersectFM COMMA)
IF_NOT_GHC(intersectFM_C COMMA)
IF_NOT_GHC(mapFM COMMA foldFM COMMA filterFM COMMA)
IF_NOT_GHC(mapFM COMMA filterFM COMMA)
sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM,
......
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