Skip to content

GitLab

Commit 9d4c0380 authored by partain's avatar partain
Browse files

[project @ 1996-06-30 15:56:44 by partain] 

partain 1.3 changes through 960629
parent da3d8948
Hide whitespace changes
Inline Side-by-side
ghc/compiler/nativeGen/RegAllocInfo.lhs
View file @ 9d4c0380
......@@ -24,8 +24,8 @@ module RegAllocInfo (
regUsage,
FutureLive(..),
RegAssignment(..),
RegConflicts(..),
SYN_IE(RegAssignment),
SYN_IE(RegConflicts),
RegFuture(..),
RegHistory(..),
RegInfo(..),
......@@ -37,7 +37,7 @@ module RegAllocInfo (
regLiveness,
spillReg,
RegSet(..),
SYN_IE(RegSet),
elementOfRegSet,
emptyRegSet,
isEmptyRegSet,
......@@ -52,15 +52,16 @@ module RegAllocInfo (
) where
IMP_Ubiq(){-uitous-}
IMPORT_1_3(List(partition))
import MachMisc
import MachRegs
import MachCode ( InstrList(..) )
import MachCode ( SYN_IE(InstrList) )
import AbsCSyn ( MagicId )
import BitSet ( unitBS, mkBS, minusBS, unionBS, listBS, BitSet )
import CLabel ( pprCLabel_asm, CLabel{-instance Ord-} )
import FiniteMap ( addToFM, lookupFM )
import FiniteMap ( addToFM, lookupFM, FiniteMap )
import OrdList ( mkUnitList, OrdList )
import PrimRep ( PrimRep(..) )
import Stix ( StixTree, CodeSegment )
......
ghc/compiler/nativeGen/Stix.lhs
View file @ 9d4c0380
......@@ -6,7 +6,7 @@
#include "HsVersions.h"
module Stix (
CodeSegment(..), StixReg(..), StixTree(..), StixTreeList(..),
CodeSegment(..), StixReg(..), StixTree(..), SYN_IE(StixTreeList),
sStLitLbl,
stgBaseReg, stgStkOReg, stgNode, stgTagReg, stgRetReg,
......@@ -16,12 +16,13 @@ module Stix (
) where
IMP_Ubiq(){-uitous-}
IMPORT_1_3(Ratio(Rational))
import AbsCSyn ( node, infoptr, MagicId(..) )
import AbsCUtils ( magicIdPrimRep )
import CLabel ( mkAsmTempLabel )
import UniqSupply ( returnUs, thenUs, getUnique, SYN_IE(UniqSM) )
import Unpretty ( uppPStr, Unpretty(..) )
import Unpretty ( uppPStr, SYN_IE(Unpretty) )
\end{code}
Here is the tag at the nodes of our @StixTree@. Notice its
......
ghc/compiler/nativeGen/StixPrim.lhs
View file @ 9d4c0380
......@@ -27,7 +27,7 @@ import OrdList ( OrdList )
import PprStyle ( PprStyle(..) )
import SMRep ( SMRep(..), SMSpecRepKind, SMUpdateKind )
import Stix
import StixMacro ( heapCheck, smStablePtrTable )
import StixMacro ( heapCheck )
import StixInteger {- everything -}
import UniqSupply ( returnUs, thenUs, SYN_IE(UniqSM) )
import Unpretty ( uppBeside, uppPStr, uppInt )
......
ghc/compiler/prelude/PrelLoop.lhi
View file @ 9d4c0380
......@@ -11,7 +11,7 @@ import IdUtils ( primOpNameInfo )
import Name ( Name, OrigName, mkPrimitiveName, mkWiredInName, ExportFlag )
import PrimOp ( PrimOp )
import RnHsSyn ( RnName )
import Type ( mkSigmaTy, mkFunTys, GenType )
import Type ( mkSigmaTy, mkFunTy, mkFunTys, GenType )
import TyVar ( GenTyVar )
import Unique ( Unique )
import Usage ( GenUsage )
......@@ -21,6 +21,7 @@ mkPrimitiveName :: Unique -> OrigName -> Name
mkWiredInName :: Unique -> OrigName -> ExportFlag -> Name
mkSigmaTy :: [a] -> [(GenClass (GenTyVar (GenUsage Unique)) Unique, GenType a b)] -> GenType a b -> GenType a b
mkFunTys :: [GenType a b] -> GenType a b -> GenType a b
mkFunTy :: GenType a b -> GenType a b -> GenType a b
primOpNameInfo :: PrimOp -> (_PackedString, RnName)
\end{code}
ghc/compiler/prelude/PrelLoop_1_3.lhi
View file @ 9d4c0380
......@@ -4,5 +4,6 @@ __exports__
Name mkWiredInName (..)
Type mkSigmaTy (..)
Type mkFunTys (..)
Type mkFunTy (..)
IdUtils primOpNameInfo (..)
\end{code}
ghc/compiler/prelude/PrimOp.lhs
View file @ 9d4c0380
......@@ -44,7 +44,7 @@ import Pretty
import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
import TyCon ( TyCon{-instances-} )
import Type ( getAppDataTyConExpandingDicts, maybeAppDataTyConExpandingDicts,
mkForAllTys, mkFunTys, applyTyCon, typePrimRep
mkForAllTys, mkFunTy, mkFunTys, applyTyCon, typePrimRep
)
import TyVar ( alphaTyVar, betaTyVar, gammaTyVar, GenTyVar{-instance Eq-} )
import Unique ( Unique{-instance Eq-} )
......@@ -1332,7 +1332,7 @@ primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
statePrimTyCon VoidRep [realWorldTy]
where
primio_ish_ty result
= mkFunTys [mkStateTy realWorldTy] (mkTupleTy 2 [result, mkStateTy realWorldTy])
= mkFunTy (mkStateTy realWorldTy) (mkTupleTy 2 [result, mkStateTy realWorldTy])
\end{code}
%************************************************************************
......@@ -1660,7 +1660,7 @@ primOpType op
Dyadic str ty -> dyadic_fun_ty ty
Monadic str ty -> monadic_fun_ty ty
Compare str ty -> compare_fun_ty ty
Coercing str ty1 ty2 -> mkFunTys [ty1] ty2
Coercing str ty1 ty2 -> mkFunTy ty1 ty2
PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
......@@ -1726,7 +1726,7 @@ commutableOp _ = False
Utils:
\begin{code}
dyadic_fun_ty ty = mkFunTys [ty, ty] ty
monadic_fun_ty ty = mkFunTys [ty] ty
monadic_fun_ty ty = mkFunTy ty ty
compare_fun_ty ty = mkFunTys [ty, ty] boolTy
\end{code}
......
ghc/compiler/prelude/TysWiredIn.lhs
View file @ 9d4c0380
......@@ -48,11 +48,11 @@ module TysWiredIn (
mkTupleTy,
nilDataCon,
primIoTyCon,
primIoDataCon,
realWorldStateTy,
return2GMPsTyCon,
returnIntAndGMPTyCon,
stTyCon,
stDataCon,
stablePtrTyCon,
stateAndAddrPrimTyCon,
stateAndArrayPrimTyCon,
......@@ -101,7 +101,7 @@ import TyCon ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
NewOrData(..), TyCon
)
import Type ( mkTyConTy, applyTyCon, mkSigmaTy,
mkFunTys, maybeAppTyCon,
mkFunTy, maybeAppTyCon,
GenType(..), SYN_IE(ThetaType), SYN_IE(TauType) )
import TyVar ( tyVarKind, alphaTyVar, betaTyVar )
import Unique
......@@ -130,6 +130,11 @@ pc_tycon new_or_data key mod str tyvars cons
where
tycon_kind = foldr (mkArrowKind . tyVarKind) mkBoxedTypeKind tyvars
pcSynTyCon key mod str kind arity tyvars expansion
= mkSynTyCon
(mkWiredInName key (OrigName mod str) ExportAll)
kind arity tyvars expansion
pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
-> [TyVar] -> ThetaType -> [TauType] -> TyCon -> SpecEnv -> Id
pcDataCon key mod str tyvars context arg_tys tycon specenv
......@@ -442,28 +447,27 @@ This is really just an ordinary synonym, except it is ABSTRACT.
mkStateTransformerTy s a = applyTyCon stTyCon [s, a]
stTyCon = pcNewTyCon stTyConKey gHC__ SLIT("ST") alpha_beta_tyvars [stDataCon]
where
ty = mkFunTys [mkStateTy alphaTy] (mkTupleTy 2 [betaTy, mkStateTy alphaTy])
stDataCon = pcDataCon stDataConKey gHC__ SLIT("ST")
stDataCon = pcDataCon stDataConKey gHC__ SLIT("ST")
alpha_beta_tyvars [] [ty] stTyCon nullSpecEnv
where
ty = mkFunTy (mkStateTy alphaTy) (mkTupleTy 2 [betaTy, mkStateTy alphaTy])
\end{code}
%************************************************************************
%* *
\subsection[TysWiredIn-IO]{The @PrimIO@ and @IO@ monadic-I/O types}
\subsection[TysWiredIn-IO]{The @PrimIO@ monadic-I/O type}
%* *
%************************************************************************
\begin{code}
mkPrimIoTy a = applyTyCon primIoTyCon [a]
mkPrimIoTy a = mkStateTransformerTy realWorldTy a
primIoTyCon = pcNewTyCon primIoTyConKey gHC__ SLIT("PrimIO") alpha_tyvar [primIoDataCon]
primIoDataCon = pcDataCon primIoDataConKey gHC__ SLIT("PrimIO")
alpha_tyvar [] [ty] primIoTyCon nullSpecEnv
where
ty = mkFunTys [mkStateTy realWorldTy] (mkTupleTy 2 [alphaTy, mkStateTy realWorldTy])
primIoTyCon
= pcSynTyCon
primIoTyConKey gHC__ SLIT("PrimIO")
(mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind)
1 alpha_tyvar (mkPrimIoTy alphaTy)
\end{code}
%************************************************************************
......
ghc/compiler/reader/ReadPrefix.lhs
View file @ 9d4c0380
......@@ -10,6 +10,7 @@ module ReadPrefix ( rdModule ) where
IMP_Ubiq()
IMPORT_1_3(IO(hPutStr, stderr))
IMPORT_1_3(GHCio(stThen))
import UgenAll -- all Yacc parser gumpff...
import PrefixSyn -- and various syntaxen.
......@@ -80,7 +81,7 @@ cvFlag 1 = True
\begin{code}
#if __GLASGOW_HASKELL__ >= 200
# define PACK_STR packCString
# define CCALL_THEN `GHCbase.ccallThen`
# define CCALL_THEN `stThen`
#else
# define PACK_STR _packCString
# define CCALL_THEN `thenPrimIO`
......@@ -410,8 +411,13 @@ wlkPat pat
(\sty -> ppInterleave ppSP (map (ppr sty) (lpat:lpats)))
msg = ppShow 100 (err PprForUser)
in
#if __GLASGOW_HASKELL__ >= 200
ioToUgnM (GHCbase.ioToPrimIO (hPutStr stderr msg)) `thenUgn` \ _ ->
ioToUgnM (GHCbase.ioToPrimIO (ghcExit 1)) `thenUgn` \ _ ->
#else
ioToUgnM (hPutStr stderr msg) `thenUgn` \ _ ->
ioToUgnM (ghcExit 1) `thenUgn` \ _ ->
#endif
returnUgn (error "ReadPrefix")
) `thenUgn` \ (n, arg_pats) ->
......
ghc/compiler/rename/ParseIface.y
View file @ 9d4c0380
......@@ -230,9 +230,8 @@ class : gtycon VARID { ($1, Unqual $2) }
ctype :: { RdrNamePolyType }
ctype : FORALL OBRACK tyvars CBRACK context DARROW type { HsForAllTy (map Unqual $3) $5 $7 }
| FORALL OBRACK tyvars CBRACK type { HsForAllTy (map Unqual $3) [] $5 }
| context DARROW type {{-ToDo:rm-} HsPreForAllTy $1 $3 }
| type {{-ToDo:change-} HsPreForAllTy [] $1 }
| FORALL OBRACK tyvars CBRACK type { HsForAllTy (map Unqual $3) [] $5 }
| type { HsForAllTy [] [] $1 }
type :: { RdrNameMonoType }
type : btype { $1 }
......@@ -364,10 +363,9 @@ instdecls : instd { unitBag $1 }
| instdecls instd { $1 `snocBag` $2 }
instd :: { RdrIfaceInst }
instd : INSTANCE FORALL OBRACK tyvars CBRACK context DARROW gtycon restrict_inst SEMI { mk_inst (Just (map Unqual $4)) $6 $8 $9 }
| INSTANCE FORALL OBRACK tyvars CBRACK gtycon general_inst SEMI { mk_inst (Just (map Unqual $4)) [] $6 $7 }
| INSTANCE context DARROW gtycon restrict_inst SEMI {{-ToDo:rm-} mk_inst Nothing $2 $4 $5 }
| INSTANCE gtycon general_inst SEMI {{-ToDo:rm-} mk_inst Nothing [] $2 $3 }
instd : INSTANCE FORALL OBRACK tyvars CBRACK context DARROW gtycon restrict_inst SEMI { mk_inst (map Unqual $4) $6 $8 $9 }
| INSTANCE FORALL OBRACK tyvars CBRACK gtycon general_inst SEMI { mk_inst (map Unqual $4) [] $6 $7 }
| INSTANCE gtycon general_inst SEMI { mk_inst [] [] $2 $3 }
restrict_inst :: { RdrNameMonoType }
restrict_inst : gtycon { MonoTyApp $1 [] }
......
ghc/compiler/rename/ParseUtils.lhs
View file @ 9d4c0380
......@@ -209,7 +209,7 @@ mk_class ctxt (qclas@(Qual mod clas), tyvar) ops_and_sigs
where
opify (Sig f ty _ loc) = ClassOpSig f ty noClassOpPragmas loc
mk_inst :: Maybe [RdrName] -- ToDo: de-maybe
mk_inst :: [RdrName]
-> RdrNameContext
-> RdrName -- class
-> RdrNameMonoType -- fish the tycon out yourself...
......@@ -217,9 +217,7 @@ mk_inst :: Maybe [RdrName] -- ToDo: de-maybe
mk_inst tvs ctxt qclas@(Qual cmod cname) mono_ty
= let
ty = case tvs of
Nothing -> HsPreForAllTy ctxt mono_ty -- ToDo: get rid of this
Just ts -> HsForAllTy ts ctxt mono_ty
ty = HsForAllTy tvs ctxt mono_ty
in
-- pprTrace "mk_inst:" (ppr PprDebug ty) $
InstSig qclas (tycon_name mono_ty) mkIfaceSrcLoc $ \ mod ->
......
ghc/compiler/rename/Rename.lhs
View file @ 9d4c0380
......@@ -11,26 +11,27 @@ module Rename ( renameModule ) where
import PreludeGlaST ( thenPrimIO )
IMP_Ubiq()
IMPORT_1_3(List(partition))
import HsSyn
import RdrHsSyn ( RdrNameHsModule(..), RdrNameImportDecl(..) )
import RnHsSyn ( RnName(..){-.. is for Ix hack only-}, RenamedHsModule(..), isRnTyConOrClass, isRnWired )
import RnHsSyn ( RnName(..){-.. is for Ix hack only-}, SYN_IE(RenamedHsModule), isRnTyConOrClass, isRnWired )
--ToDo:rm: all for debugging only
import Maybes
import Name
import Outputable
import RnIfaces
import PprStyle
import Pretty
import FiniteMap
import Util (pprPanic, pprTrace)
--import Maybes
--import Name
--import Outputable
--import RnIfaces
--import PprStyle
--import Pretty
--import FiniteMap
--import Util (pprPanic, pprTrace)
import ParseUtils ( ParsedIface(..), RdrIfaceDecl(..), RdrIfaceInst(..),
UsagesMap(..), VersionsMap(..)
)
import RnMonad
import RnNames ( getGlobalNames, GlobalNameInfo(..) )
import RnNames ( getGlobalNames, SYN_IE(GlobalNameInfo) )
import RnSource ( rnSource )
import RnIfaces ( rnIfaces, initIfaceCache, IfaceCache )
import RnUtils ( SYN_IE(RnEnv), extendGlobalRnEnv, emptyRnEnv )
......@@ -38,14 +39,19 @@ import RnUtils ( SYN_IE(RnEnv), extendGlobalRnEnv, emptyRnEnv )
import Bag ( isEmptyBag, unionBags, unionManyBags, bagToList, listToBag )
import CmdLineOpts ( opt_HiMap, opt_NoImplicitPrelude )
import ErrUtils ( SYN_IE(Error), SYN_IE(Warning) )
import FiniteMap ( emptyFM, eltsFM, fmToList, lookupFM{-ToDo:rm-} )
import FiniteMap ( emptyFM, eltsFM, fmToList, addToFM, lookupFM{-ToDo:rm-}, FiniteMap )
import Maybes ( catMaybes )
import Name ( isLocallyDefined, mkWiredInName, Name, RdrName(..), ExportFlag(..) )
import Name ( isLocallyDefined, mkWiredInName, getLocalName, isLocalName,
origName,
Name, RdrName(..), ExportFlag(..)
)
import PprStyle -- ToDo:rm
import PrelInfo ( builtinNameInfo, SYN_IE(BuiltinNames), SYN_IE(BuiltinKeys) )
import Pretty -- ToDo:rm
import Unique ( ixClassKey )
import UniqFM ( emptyUFM, lookupUFM, addListToUFM_C, eltsUFM )
import UniqSupply ( splitUniqSupply )
import Util ( panic, assertPanic )
import Util ( panic, assertPanic, pprTrace{-ToDo:rm-} )
\end{code}
\begin{code}
......
ghc/compiler/rename/RnIfaces.lhs
View file @ 9d4c0380
......@@ -15,7 +15,15 @@ module RnIfaces (
IMP_Ubiq()
import PreludeGlaST ( thenPrimIO, seqPrimIO, newVar, readVar, writeVar, MutableVar(..) )
import PreludeGlaST ( thenPrimIO, newVar, readVar, writeVar, SYN_IE(MutableVar) )
#if __GLASGOW_HASKELL__ >= 200
# define ST_THEN `stThen`
# define TRY_IO tryIO
IMPORT_1_3(GHCio(stThen,tryIO))
#else
# define ST_THEN `thenPrimIO`
# define TRY_IO try
#endif
import HsSyn
import HsPragmas ( noGenPragmas )
......@@ -35,16 +43,15 @@ import Bag ( emptyBag, unitBag, consBag, snocBag,
import ErrUtils ( SYN_IE(Error), SYN_IE(Warning) )
import FiniteMap ( emptyFM, lookupFM, addToFM, addToFM_C, plusFM, eltsFM,
fmToList, delListFromFM, sizeFM, foldFM, unitFM,
plusFM_C, addListToFM, keysFM{-ToDo:rm-}
plusFM_C, addListToFM, keysFM{-ToDo:rm-}, FiniteMap
)
import Maybes ( maybeToBool )
import Maybes ( maybeToBool, MaybeErr(..) )
import Name ( origName, moduleOf, nameOf, qualToOrigName, OrigName(..),
isLexCon, RdrName(..), Name{-instance NamedThing-} )
import PprStyle -- ToDo:rm
import Outputable -- ToDo:rm
import PrelInfo ( builtinNameInfo, SYN_IE(BuiltinNames) )
import Pretty
import Maybes ( MaybeErr(..) )
import UniqFM ( emptyUFM )
import UniqSupply ( splitUniqSupply )
import Util ( sortLt, removeDups, cmpPString, startsWith,
......@@ -55,19 +62,25 @@ import Util ( sortLt, removeDups, cmpPString, startsWith,
type ModuleToIfaceContents = FiniteMap Module ParsedIface
type ModuleToIfaceFilePath = FiniteMap Module FilePath
#if __GLASGOW_HASKELL__ >= 200
# define REAL_WORLD RealWorld
#else
# define REAL_WORLD _RealWorld
#endif
data IfaceCache
= IfaceCache
Module -- the name of the module being compiled
BuiltinNames -- so we can avoid going after things
-- the compiler already knows about
(MutableVar _RealWorld
(MutableVar REAL_WORLD
(ModuleToIfaceContents, -- interfaces for individual interface files
ModuleToIfaceContents, -- merged interfaces based on module name
-- used for extracting info about original names
ModuleToIfaceFilePath))
initIfaceCache mod hi_files
= newVar (emptyFM,emptyFM,hi_files) `thenPrimIO` \ iface_var ->
= newVar (emptyFM,emptyFM,hi_files) ST_THEN \ iface_var ->
return (IfaceCache mod b_names iface_var)
where
b_names = case builtinNameInfo of (b_names,_,_) -> b_names
......@@ -110,7 +123,7 @@ cachedIface :: IfaceCache
-> IO (MaybeErr ParsedIface Error)
cachedIface (IfaceCache _ _ iface_var) want_orig_iface item modname
= readVar iface_var `thenPrimIO` \ (iface_fm, orig_fm, file_fm) ->
= readVar iface_var ST_THEN \ (iface_fm, orig_fm, file_fm) ->
case (lookupFM iface_fm modname) of
Just iface -> return (want_iface iface orig_fm)
......@@ -127,7 +140,7 @@ cachedIface (IfaceCache _ _ iface_var) want_orig_iface item modname
iface_fm' = addToFM iface_fm modname iface
orig_fm' = addToFM_C mergeIfaces orig_fm (iface_mod iface) iface
in
writeVar iface_var (iface_fm', orig_fm', file_fm) `seqPrimIO`
writeVar iface_var (iface_fm', orig_fm', file_fm) ST_THEN \ _ ->
return (want_iface iface orig_fm')
where
want_iface iface orig_fm
......@@ -274,7 +287,7 @@ readIface :: FilePath -> Module -> FAST_STRING -> IO (MaybeErr ParsedIface Error
readIface file modname item
= --hPutStr stderr (" reading "++file++" ("++ _UNPK_ item ++")") >>
readFile file `thenPrimIO` \ read_result ->
TRY_IO (readFile file) >>= \ read_result ->
case read_result of
Left err -> return (Failed (cannaeReadErr file err))
Right contents -> --hPutStr stderr ".." >>
......@@ -540,7 +553,7 @@ data AddedDecl -- purely local
| AddedSig RenamedSig
rnIfaceDecl :: RdrIfaceDecl
-> RnM_Fixes _RealWorld
-> RnM_Fixes REAL_WORLD
(AddedDecl, -- the resulting decl to add to the pot
([(RdrName,RnName)], [(RdrName,RnName)]),
-- new val/tycon-class names that have
......@@ -621,7 +634,7 @@ sub (val_ment, tc_ment) (val_defds, tc_defds)
cacheInstModules :: IfaceCache -> [Module] -> IO (Bag Error)
cacheInstModules iface_cache@(IfaceCache _ _ iface_var) imp_mods
= readVar iface_var `thenPrimIO` \ (iface_fm, _, _) ->
= readVar iface_var ST_THEN \ (iface_fm, _, _) ->
let
imp_ifaces = [ iface | Just iface <- map (lookupFM iface_fm) imp_mods ]
(imp_imods, _) = removeDups cmpPString (bagToList (unionManyBags (map get_ims imp_ifaces)))
......@@ -634,7 +647,7 @@ cacheInstModules iface_cache@(IfaceCache _ _ iface_var) imp_mods
-- Assert that instance modules given by direct imports contains
-- instance modules extracted from all visited modules
readVar iface_var `thenPrimIO` \ (all_iface_fm, _, _) ->
readVar iface_var ST_THEN \ (all_iface_fm, _, _) ->
let
all_ifaces = eltsFM all_iface_fm
(all_imods, _) = removeDups cmpPString (bagToList (unionManyBags (map get_ims (all_ifaces))))
......@@ -670,7 +683,7 @@ rnIfaceInstStuff iface_cache@(IfaceCache _ _ iface_var) modname us occ_env done_
= -- all the instance decls we might even want to consider
-- are in the ParsedIfaces that are in our cache
readVar iface_var `thenPrimIO` \ (_, orig_iface_fm, _) ->
readVar iface_var ST_THEN \ (_, orig_iface_fm, _) ->
let
all_ifaces = eltsFM orig_iface_fm
all_insts = concat (map get_insts all_ifaces)
......@@ -752,7 +765,7 @@ rnIfaceInstStuff iface_cache@(IfaceCache _ _ iface_var) modname us occ_env done_
\end{code}
\begin{code}
rnIfaceInst :: (Module, RdrIfaceInst) -> RnM_Fixes _RealWorld RenamedInstDecl
rnIfaceInst :: (Module, RdrIfaceInst) -> RnM_Fixes REAL_WORLD RenamedInstDecl
rnIfaceInst (imod, InstSig _ _ _ inst_decl) = rnInstDecl (inst_decl imod)
\end{code}
......@@ -778,7 +791,7 @@ finalIfaceInfo iface_cache@(IfaceCache _ _ iface_var) modname if_final_env@((qua
-- 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))) $
readVar iface_var `thenPrimIO` \ (_, orig_iface_fm, _) ->
readVar iface_var ST_THEN \ (_, orig_iface_fm, _) ->
let
all_ifaces = eltsFM orig_iface_fm
-- all the interfaces we have looked at
......
ghc/compiler/rename/RnLoop_1_3.lhi
View file @ 9d4c0380
\begin{code}
interface RnLoop_1_3 1
__exports__
Outputable Outputable (..)
RnBinds rnBinds (..)
RnBinds FreeVars
RnSource rnPolyType (..)
\end{code}
ghc/compiler/rename/RnNames.lhs
View file @ 9d4c0380
......@@ -8,10 +8,10 @@
module RnNames (
getGlobalNames,
GlobalNameInfo(..)
SYN_IE(GlobalNameInfo)
) where
import PreludeGlaST ( MutableVar(..) )
import PreludeGlaST ( SYN_IE(MutableVar) )
IMP_Ubiq()
......@@ -31,7 +31,7 @@ import Bag ( emptyBag, unitBag, consBag, snocBag, unionBags,
unionManyBags, mapBag, filterBag, listToBag, bagToList )
import CmdLineOpts ( opt_NoImplicitPrelude, opt_CompilingGhcInternals )
import ErrUtils ( SYN_IE(Error), SYN_IE(Warning), addErrLoc, addShortErrLocLine, addShortWarnLocLine )
import FiniteMap ( emptyFM, addToFM, addListToFM, lookupFM, fmToList, eltsFM, delListFromFM, keysFM{-ToDo:rm-} )
import FiniteMap ( emptyFM, addToFM, addListToFM, lookupFM, fmToList, eltsFM, delListFromFM, keysFM{-ToDo:rm-}, FiniteMap )
import Id ( GenId )
import Maybes ( maybeToBool, catMaybes, MaybeErr(..) )
import Name ( RdrName(..), Name, isQual, mkTopLevName, mkWiredInName, origName,
......@@ -514,7 +514,7 @@ doImport :: IfaceCache
doImport iface_cache info us (ImportDecl mod qual maybe_as maybe_spec src_loc)
= let
(b_vals, b_tcs, maybe_spec') = getBuiltins info mod maybe_spec
(b_vals, b_tcs, maybe_spec') = getBuiltins info mod maybe_spec -- NB: a no-op ToDo:rm
in
(if mod == gHC_BUILTINS then
return (Succeeded (panic "doImport:GHC fake import!"),
......@@ -591,9 +591,10 @@ getBuiltins :: ImportNameInfo
)
getBuiltins _ modname maybe_spec
| modname `notElem` modulesWithBuiltins
--OLD: | modname `notElem` modulesWithBuiltins
= (emptyBag, emptyBag, maybe_spec)
{-
getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) modname maybe_spec
= case maybe_spec of
Nothing -> (all_vals, all_tcs, Nothing)
......@@ -649,6 +650,7 @@ getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) modname maybe_spec
_ -> panic "importing builtin names (2)"
where
(vals, tcs, ies_left) = do_builtin ies
-}
-------------------------
getOrigIEs :: ParsedIface
......
ghc/compiler/rename/RnSource.lhs
View file @ 9d4c0380
......@@ -10,6 +10,7 @@ module RnSource ( rnSource, rnTyDecl, rnClassDecl, rnInstDecl, rnPolyType ) wher
IMP_Ubiq()
IMPORT_DELOOPER(RnLoop) -- *check* the RnPass/RnExpr/RnBinds loop-breaking
IMPORT_1_3(List(partition))
import HsSyn
import HsPragmas
......
ghc/compiler/simplCore/SimplCase.lhs
View file @ 9d4c0380
......@@ -34,7 +34,7 @@ import PrimOp ( primOpOkForSpeculation, PrimOp{-instance Eq-} )
import SimplEnv
import SimplMonad
import SimplUtils ( mkValLamTryingEta )
import Type ( isPrimType, maybeAppDataTyConExpandingDicts, mkFunTys, eqTy )
import Type ( isPrimType, maybeAppDataTyConExpandingDicts, mkFunTy, mkFunTys, eqTy )
import TysPrim ( voidTy )
import Unique ( Unique{-instance Eq-} )
import Usage ( GenUsage{-instance Eq-} )
......@@ -475,7 +475,7 @@ bindLargeRhs env args rhs_ty rhs_c
dead DeadCode = True
dead other = False
prim_rhs_fun_ty = mkFunTys [voidTy] rhs_ty
prim_rhs_fun_ty = mkFunTy voidTy rhs_ty
\end{code}
Case alternatives when we don't know the scrutinee
......
ghc/compiler/simplCore/SimplCore.lhs
View file @ 9d4c0380
......@@ -9,6 +9,7 @@
module SimplCore ( core2core ) where
IMP_Ubiq(){-uitous-}
IMPORT_1_3(IO(hPutStr,stderr))
import AnalFBWW ( analFBWW )
import Bag ( isEmptyBag, foldBag )
......@@ -35,6 +36,7 @@ import CoreSyn
import CoreUnfold
import CoreUtils ( substCoreBindings, manifestlyWHNF )
import ErrUtils ( ghcExit )
import FiniteMap ( FiniteMap )
import FloatIn ( floatInwards )
import FloatOut ( floatOutwards )
import FoldrBuildWW ( mkFoldrBuildWW )
......
ghc/compiler/simplCore/Simplify.lhs
View file @ 9d4c0380
......@@ -10,6 +10,7 @@ module Simplify ( simplTopBinds, simplExpr, simplBind ) where
IMP_Ubiq(){-uitous-}
IMPORT_DELOOPER(SmplLoop) -- paranoia checking
IMPORT_1_3(List(partition))
import BinderInfo
import CmdLineOpts ( SimplifierSwitch(..) )
......
ghc/compiler/typecheck/GenSpecEtc.lhs
View file @ 9d4c0380
......@@ -15,12 +15,12 @@ module GenSpecEtc (
IMP_Ubiq()
import TcMonad hiding ( rnMtoTcM )
import Inst ( Inst, InstOrigin(..), LIE(..), plusLIE,
import Inst ( Inst, InstOrigin(..), SYN_IE(LIE), plusLIE,
newDicts, tyVarsOfInst, instToId )
import TcEnv ( tcGetGlobalTyVars, tcExtendGlobalTyVars )
import TcSimplify ( tcSimplify, tcSimplifyAndCheck )
import TcType ( TcType(..), TcThetaType(..), TcTauType(..),
TcTyVarSet(..), TcTyVar(..),
import TcType ( SYN_IE(TcType), SYN_IE(TcThetaType), SYN_IE(TcTauType),
SYN_IE(TcTyVarSet), SYN_IE(TcTyVar),
newTyVarTy, zonkTcType, zonkTcTyVar, zonkTcTyVars
)
import Unify ( unifyTauTy )
......@@ -28,7 +28,7 @@ import Unify ( unifyTauTy )
import HsSyn ( HsBinds(..), Bind(..), MonoBinds(..), HsExpr, OutPat(..),
Sig, HsLit, ArithSeqInfo, InPat, GRHSsAndBinds, Match, Fake
)
import TcHsSyn ( TcIdOcc(..), TcIdBndr(..), TcHsBinds(..), TcBind(..), TcExpr(..), tcIdType )
import TcHsSyn ( TcIdOcc(..), SYN_IE(TcIdBndr), SYN_IE(TcHsBinds), SYN_IE(TcBind), SYN_IE(TcExpr), tcIdType )
import Bag ( Bag, foldBag, bagToList, listToBag, isEmptyBag )
import Class ( GenClass )
......
ghc/compiler/typecheck/Inst.lhs
View file @ 9d4c0380
......@@ -10,9 +10,9 @@ module Inst (
Inst(..), -- Visible only to TcSimplify
InstOrigin(..), OverloadedLit(..),
LIE(..), emptyLIE, unitLIE, plusLIE, consLIE, zonkLIE, plusLIEs,
SYN_IE(LIE), emptyLIE, unitLIE, plusLIE, consLIE, zonkLIE, plusLIEs,
InstanceMapper(..),
SYN_IE(InstanceMapper),
newDicts, newDictsAtLoc, newMethod, newMethodWithGivenTy, newOverloadedLit,
......@@ -29,22 +29,25 @@ module Inst (
) where
IMP_Ubiq()
IMPORT_1_3(Ratio(Rational))
import HsSyn ( HsLit(..), HsExpr(..), HsBinds,
InPat, OutPat, Stmt, Qualifier, Match,
ArithSeqInfo, PolyType, Fake )
import RnHsSyn ( RenamedArithSeqInfo(..), RenamedHsExpr(..) )
import TcHsSyn ( TcIdOcc(..), TcExpr(..), TcIdBndr(..),
import RnHsSyn ( SYN_IE(RenamedArithSeqInfo), SYN_IE(RenamedHsExpr),
RnName{-instance NamedThing-}