Commit 573ef10b authored by partain's avatar partain

[project @ 1996-07-15 11:32:34 by partain]

partain changes to 960714
parent 30f15b4e
......@@ -37,7 +37,7 @@ SuffixRule_c_o()
*/
SUBDIR_LIST = \ /* here they are, colon separated (for mkdependHS) */
utils:basicTypes:types:hsSyn:prelude:envs:rename:typecheck:deSugar:coreSyn:specialise:simplCore:stranal:stgSyn:simplStg:codeGen:nativeGen:absCSyn:main:reader:profiling:deforest:parser
utils:basicTypes:types:hsSyn:prelude:rename:typecheck:deSugar:coreSyn:specialise:simplCore:stranal:stgSyn:simplStg:codeGen:nativeGen:absCSyn:main:reader:profiling:deforest:parser
#ifdef MainIncludeDir
MAIN_INCLUDE_DIR=MainIncludeDir
......@@ -365,21 +365,21 @@ BACKSRCS_LHS NATIVEGEN_SRCS_LHS
# define loop_hi(f) CAT2(f,.hi)
#endif
DELOOP_HIs = \
utils/Ubiq.hi \
absCSyn/AbsCLoop.hi \
basicTypes/IdLoop.hi \
codeGen/CgLoop1.hi \
codeGen/CgLoop2.hi \
deSugar/DsLoop.hi \
hsSyn/HsLoop.hi \
nativeGen/NcgLoop.hi \
prelude/PrelLoop.hi \
rename/RnLoop.hi \
simplCore/SmplLoop.hi \
typecheck/TcMLoop.hi \
typecheck/TcLoop.hi \
types/TyLoop.hi
DELOOP_HIs = \
loop_hi(utils/Ubiq) \
loop_hi(absCSyn/AbsCLoop) \
loop_hi(basicTypes/IdLoop) \
loop_hi(codeGen/CgLoop1) \
loop_hi(codeGen/CgLoop2) \
loop_hi(deSugar/DsLoop) \
loop_hi(hsSyn/HsLoop) \
loop_hi(nativeGen/NcgLoop) \
loop_hi(prelude/PrelLoop) \
loop_hi(rename/RnLoop) \
loop_hi(simplCore/SmplLoop) \
loop_hi(typecheck/TcMLoop) \
loop_hi(typecheck/TcLoop) \
loop_hi(types/TyLoop)
/*
\
......@@ -441,6 +441,10 @@ HC = $(GHC) /* uses the driver herein */
BuildPgmFromHaskellModules(hsc,$(ALLOBJS) parser/hsclink.o parser/hschooks.o,,libhsp.a)
parser/hschooks.o : parser/hschooks.c
$(RM) $@
$(HC) -c -o $@ $(HCFLAGS) parser/hschooks.c
#if DoInstallGHCSystem == YES
MakeDirectories(install, $(INSTLIBDIR_GHC))
InstallBinaryTarget(hsc,$(INSTLIBDIR_GHC))
......@@ -512,7 +516,7 @@ compile(absCSyn/AbsCSyn,lhs,if_ghc(-fno-omit-reexported-instances))
compile(hsSyn/HsBinds,lhs,)
compile(hsSyn/HsCore,lhs,)
compile(hsSyn/HsDecls,lhs,)
compile(hsSyn/HsExpr,lhs,)
compile(hsSyn/HsExpr,lhs,if_ghc(-K2m))
compile(hsSyn/HsImpExp,lhs,)
compile(hsSyn/HsLit,lhs,)
compile(hsSyn/HsMatches,lhs,)
......@@ -586,7 +590,7 @@ compile(nativeGen/AsmRegAlloc,lhs,-I$(COMPINFO_DIR))
compile(nativeGen/MachCode,lhs,-I$(NATIVEGEN_DIR))
compile(nativeGen/MachMisc,lhs,-I$(NATIVEGEN_DIR))
compile(nativeGen/MachRegs,lhs,-I$(NATIVEGEN_DIR))
compile(nativeGen/PprMach,lhs,-I$(NATIVEGEN_DIR))
compile(nativeGen/PprMach,lhs,-I$(NATIVEGEN_DIR) if_ghc(-K2m))
compile(nativeGen/RegAllocInfo,lhs,-I$(NATIVEGEN_DIR))
compile(nativeGen/Stix,lhs,)
compile(nativeGen/StixInfo,lhs,)
......@@ -617,7 +621,7 @@ compile(rename/RnHsSyn,lhs,)
compile(rename/RnMonad,lhs,if_ghc(-fvia-C))
compile(rename/Rename,lhs,)
compile(rename/RnNames,lhs,)
compile(rename/RnSource,lhs,)
compile(rename/RnSource,lhs,-H12m)
compile(rename/RnBinds,lhs,)
compile(rename/RnExpr,lhs,)
compile(rename/RnIfaces,lhs,)
......@@ -807,7 +811,7 @@ UgenNeededHere(all depend)
NormalLibraryTarget(hsp,$(HSP_OBJS_O))
/* We need the hsp program for hstags to work! */
BuildPgmFromCFiles(hsp,parser/printtree.o parser/main.o,,libhsp.a)
/* BuildPgmFromCFiles(hsp,parser/printtree.o parser/main.o,,libhsp.a) */
#if DoInstallGHCSystem == YES
MakeDirectories(install, $(INSTLIBDIR_GHC))
......@@ -874,6 +878,11 @@ compile(parser/U_ttype,hs,$(PARSER_HS_OPTS) '-#include"hspincl.h"')
DEPSRCS = $(ALLSRCS_LHS) $(ALLSRCS_HS)
#if GhcBuilderVersion < 200
/* this will go away soon enough... (once 1.3 is settled in) */
MKDEPENDHS = mkdependHS-1.2
#endif
#if GhcWithHscBuiltViaC == NO
MKDEPENDHS_OPTS= -I$(MAIN_INCLUDE_DIR) -I$(COMPINFO_DIR) -x HsVersions.h
#else /* booting from .hc */
......
......@@ -75,6 +75,7 @@ module Id (
isTopLevId,
isTupleCon,
isWorkerId,
isWrapperId,
toplevelishId,
unfoldingUnfriendlyId,
......@@ -101,6 +102,7 @@ module Id (
getIdUnfolding,
getIdUpdateInfo,
getPragmaInfo,
replaceIdInfo,
-- IdEnvs AND IdSets
SYN_IE(IdEnv), SYN_IE(GenIdSet), SYN_IE(IdSet),
......@@ -606,9 +608,7 @@ isSuperDictSelId_maybe other_id = Nothing
isWorkerId (Id _ _ _ (WorkerId _) _ _) = True
isWorkerId other = False
{-LATER:
isWrapperId id = workerExists (getIdStrictness id)
-}
\end{code}
\begin{code}
......@@ -778,7 +778,7 @@ unfoldingUnfriendlyId -- return True iff it is definitely a bad
-> Bool -- mentions this Id. Reason: it cannot
-- possibly be seen in another module.
unfoldingUnfriendlyId id = panic "Id.unfoldingUnfriendlyId"
unfoldingUnfriendlyId id = True -- ToDo:panic "Id.unfoldingUnfriendlyId"
{-LATER:
unfoldingUnfriendlyId id
......@@ -1213,11 +1213,11 @@ getPragmaInfo :: GenId ty -> PragmaInfo
getIdInfo (Id _ _ _ _ _ info) = info
getPragmaInfo (Id _ _ _ _ info _) = info
{-LATER:
replaceIdInfo :: Id -> IdInfo -> Id
replaceIdInfo (Id u n ty _ details) info = Id u n ty info details
replaceIdInfo (Id u n ty details pinfo _) info = Id u n ty details pinfo info
{-LATER:
selectIdInfoForSpecId :: Id -> IdInfo
selectIdInfoForSpecId unspec
= ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
......
......@@ -567,7 +567,7 @@ or an Absent {\em that we accept}.
indicatesWorker :: [Demand] -> Bool
indicatesWorker dems
= fake_mk_ww (trace "mAX_WORKER_ARGS" 6 - nonAbsentArgs dems) dems
= fake_mk_ww (mAX_WORKER_ARGS - nonAbsentArgs dems) dems
where
fake_mk_ww _ [] = False
fake_mk_ww _ (WwLazy True : _) = True -- we accepted an Absent
......
......@@ -71,8 +71,6 @@ import Unique ( funTyConKey, mkTupleDataConUnique, mkTupleTyConUnique,
pprUnique, Unique
)
import Util ( thenCmp, _CMP_STRING_, nOfThem, panic, assertPanic, pprTrace{-ToDo:rm-} )
import {-hide from mkdependHS-}
RnHsSyn ( RnName ) -- instance for specializing only
#ifdef REALLY_HASKELL_1_3
ord = fromEnum :: Char -> Int
......@@ -269,7 +267,9 @@ mkCompoundName :: Unique
-> Name -- from which we get provenance, etc....
-> Name -- result!
mkCompoundName u m str ns (Local _ _ _ _) = panic "mkCompoundName:Local?"
mkCompoundName u m str ns (Local _ _ _ locn) -- these arise for workers...
= Local u str True{-emph uniq-} locn
mkCompoundName u m str ns (Global _ _ _ prov exp _)
= Global u m (Right (Right str : ns)) prov exp []
......@@ -304,9 +304,9 @@ mkTupleTyConName arity
mkTupNameStr 0 = SLIT("()")
mkTupNameStr 1 = panic "Name.mkTupNameStr: 1 ???"
mkTupNameStr 2 = SLIT("(,)") -- not strictly necessary
mkTupNameStr 3 = SLIT("(,,)") -- ditto
mkTupNameStr 4 = SLIT("(,,,)") -- ditto
mkTupNameStr 2 = _PK_ "(,)" -- not strictly necessary
mkTupNameStr 3 = _PK_ "(,,)" -- ditto
mkTupNameStr 4 = _PK_ "(,,,)" -- ditto
mkTupNameStr n
= _PK_ ("(" ++ nOfThem (n-1) ',' ++ ")")
......
......@@ -77,7 +77,7 @@ unpackSrcLoc (SrcLoc2 src_file src_line) = (src_file, _PK_ (show IBOX(src_line))
\begin{code}
instance Outputable SrcLoc where
ppr PprForUser (SrcLoc src_file src_line)
= ppBesides [ ppChar '"', ppPStr src_file, ppPStr SLIT("\", line "), ppPStr src_line ]
= ppBesides [ ppChar '"', ppPStr src_file, ppStr "\", line ", ppPStr src_line ]
ppr sty (SrcLoc src_file src_line)
= ppBesides [ppPStr SLIT("{-# LINE "), ppPStr src_line, ppSP,
......
......@@ -112,8 +112,6 @@ module Unique (
liftTyConKey,
listTyConKey,
ltDataConKey,
mainIdKey,
mainPrimIOIdKey,
monadClassKey,
monadPlusClassKey,
monadZeroClassKey,
......@@ -615,8 +613,6 @@ integerPlusTwoIdKey = mkPreludeMiscIdUnique 14
integerZeroIdKey = mkPreludeMiscIdUnique 15
irrefutPatErrorIdKey = mkPreludeMiscIdUnique 16
lexIdKey = mkPreludeMiscIdUnique 17
mainIdKey = mkPreludeMiscIdUnique 18
mainPrimIOIdKey = mkPreludeMiscIdUnique 19
noDefaultMethodErrorIdKey = mkPreludeMiscIdUnique 20
nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 21
nonExplicitMethodErrorIdKey = mkPreludeMiscIdUnique 22
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[CgClosure]{Code generation for closures}
......@@ -49,7 +49,7 @@ import ClosureInfo -- lots and lots of stuff
import CmdLineOpts ( opt_ForConcurrent, opt_GranMacros )
import CostCentre ( useCurrentCostCentre, currentOrSubsumedCosts,
noCostCentreAttached, costsAreSubsumed,
isCafCC, isDictCC, overheadCostCentre
isCafCC, isDictCC, overheadCostCentre, showCostCentre
)
import HeapOffs ( SYN_IE(VirtualHeapOffset) )
import Id ( idType, idPrimRep,
......@@ -59,13 +59,14 @@ import Id ( idType, idPrimRep,
)
import ListSetOps ( minusList )
import Maybes ( maybeToBool )
import Outputable ( Outputable(..){-instances-} ) -- ToDo:rm
import PprStyle ( PprStyle(..) )
import PprType ( GenType{-instance Outputable-}, TyCon{-ditto-} )
import Pretty ( prettyToUn, ppBesides, ppChar, ppPStr )
import Pretty ( prettyToUn, ppBesides, ppChar, ppPStr, ppCat, ppStr )
import PrimRep ( isFollowableRep, PrimRep(..) )
import TyCon ( isPrimTyCon, tyConDataCons )
import Unpretty ( uppShow )
import Util ( isIn, panic, pprPanic, assertPanic )
import Util ( isIn, panic, pprPanic, assertPanic, pprTrace{-ToDo:rm-} )
myWrapperMaybe = panic "CgClosure.myWrapperMaybe (ToDo)"
showTypeCategory = panic "CgClosure.showTypeCategory (ToDo)"
......@@ -409,8 +410,12 @@ closureCodeBody binder_info closure_info cc [] body
body_addr = CLbl (entryLabelFromCI closure_info) CodePtrRep
body_code = profCtrC SLIT("ENT_THK") [] `thenC`
enterCostCentreCode closure_info cc IsThunk `thenC`
thunkWrapper closure_info (cgExpr body)
thunkWrapper closure_info (
-- We only enter cc after setting up update so that cc
-- of enclosing scope will be recorded in update frame
-- CAF/DICT functions will be subsumed by this enclosing cc
enterCostCentreCode closure_info cc IsThunk `thenC`
cgExpr body)
stdUpd = CLbl mkErrorStdEntryLabel CodePtrRep
\end{code}
......@@ -580,9 +585,9 @@ Node is guaranteed to point to it, if profiling and not inherited.
\begin{code}
data IsThunk = IsThunk | IsFunction -- Bool-like, local
#ifdef DEBUG
--#ifdef DEBUG
deriving Eq
#endif
--#endif
enterCostCentreCode :: ClosureInfo -> CostCentre -> IsThunk -> Code
......@@ -594,8 +599,9 @@ enterCostCentreCode closure_info cc is_thunk
ASSERT(not (noCostCentreAttached cc))
if costsAreSubsumed cc then
ASSERT(isToplevClosure closure_info)
ASSERT(is_thunk == IsFunction)
--ASSERT(isToplevClosure closure_info)
--ASSERT(is_thunk == IsFunction)
(if isToplevClosure closure_info && is_thunk == IsFunction then \x->x else pprTrace "enterCostCenterCode:" (ppCat [ppr PprDebug (is_thunk == IsFunction){-, ppr PprDebug closure_info-}, ppStr (showCostCentre PprDebug False cc)])) $
costCentresC SLIT("ENTER_CC_FSUB") []
else if currentOrSubsumedCosts cc then
......@@ -704,8 +710,8 @@ thunkWrapper closure_info thunk_code
let
emit_gran_macros = opt_GranMacros
in
-- HWL: insert macros for GrAnSim; 2 versions depending on liveness of node
-- (we prefer fetchAndReschedule-style context switches to yield ones)
-- HWL: insert macros for GrAnSim; 2 versions depending on liveness of node
-- (we prefer fetchAndReschedule-style context switches to yield ones)
(if emit_gran_macros
then if node_points
then fetchAndReschedule [] node_points
......@@ -714,19 +720,20 @@ thunkWrapper closure_info thunk_code
stackCheck closure_info [] node_points ( -- stackCheck *encloses* the rest
-- Must be after stackCheck: if stchk fails new stack
-- space has to be allocated from the heap
-- heapCheck must be after stackCheck: if stchk fails
-- new stack space is allocated from the heap which
-- would violate any previous heapCheck
heapCheck [] node_points (
-- heapCheck *encloses* the rest
-- The "[]" says there are no live argument registers
heapCheck [] node_points ( -- heapCheck *encloses* the rest
-- The "[]" says there are no live argument registers
-- Overwrite with black hole if necessary
blackHoleIt closure_info `thenC`
blackHoleIt closure_info `thenC`
-- Push update frame if necessary
setupUpdate closure_info ( -- setupUpdate *encloses* the rest
thunk_code
setupUpdate closure_info ( -- setupUpdate *encloses* the rest
-- Finally, do the business
thunk_code
)))
funWrapper :: ClosureInfo -- Closure whose code body this is
......@@ -744,11 +751,11 @@ funWrapper closure_info arg_regs fun_body
then yield arg_regs node_points
else absC AbsCNop) `thenC`
stackCheck closure_info arg_regs node_points ( -- stackCheck *encloses* the rest
stackCheck closure_info arg_regs node_points (
-- stackCheck *encloses* the rest
-- Heap overflow check
heapCheck arg_regs node_points (
-- heapCheck *encloses* the rest
-- heapCheck *encloses* the rest
-- Finally, do the business
fun_body
......
......@@ -10,22 +10,22 @@ monadic stuff fits into the Big Picture.
#include "HsVersions.h"
module CgMonad (
Code(..), -- type
FCode(..), -- type
SYN_IE(Code), -- type
SYN_IE(FCode), -- type
initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs,
returnFC, fixC, absC, nopC, getAbsC,
forkClosureBody, forkStatics, forkAlts, forkEval,
forkEvalHelp, forkAbsC,
SemiTaggingStuff(..),
SYN_IE(SemiTaggingStuff),
addBindC, addBindsC, modifyBindC, lookupBindC,
EndOfBlockInfo(..),
setEndOfBlockInfo, getEndOfBlockInfo,
AStackUsage(..), BStackUsage(..), HeapUsage(..),
SYN_IE(AStackUsage), SYN_IE(BStackUsage), SYN_IE(HeapUsage),
StubFlag,
isStubbed,
......
......@@ -90,7 +90,7 @@ import IdInfo ( arityMaybe )
import Maybes ( assocMaybe, maybeToBool )
import Name ( isLocallyDefined, nameOf, origName )
import PprStyle ( PprStyle(..) )
import PprType ( GenType{-instance Outputable-} )
import PprType ( getTyDescription, GenType{-instance Outputable-} )
import Pretty--ToDo:rm
import PrelInfo ( maybeCharLikeTyCon, maybeIntLikeTyCon )
import PrimRep ( getPrimRepSize, separateByPtrFollowness )
......@@ -100,8 +100,6 @@ import Type ( isPrimType, splitForAllTy, splitFunTyExpandingDictsAndPeeking,
mkFunTys, maybeAppSpecDataTyConExpandingDicts
)
import Util ( isIn, mapAccumL, panic, pprPanic, assertPanic )
getTyDescription = panic "ClosureInfo.getTyDescription (ToDo)"
\end{code}
The ``wrapper'' data type for closure information:
......
......@@ -316,7 +316,8 @@ sizeExpr scc_s_OK bOMB_OUT_SIZE args expr
size_alg_alt (con,args,rhs) = size_up rhs
-- Don't charge for args, so that wrappers look cheap
(tycon, _, _) = trace "CoreUnfold.getAppDataTyConExpandingDicts" $ getAppDataTyConExpandingDicts scrut_ty
(tycon, _, _) = --trace "CoreUnfold.getAppDataTyConExpandingDicts" $
getAppDataTyConExpandingDicts scrut_ty
size_up_alts _ (PrimAlts alts deflt)
= foldr (addSize . size_prim_alt) (size_up_deflt deflt) alts
......
......@@ -265,6 +265,28 @@ ppr_expr pe expr@(App _ _)
])
ppr_expr pe (Case expr alts)
| only_one_alt alts
-- johan thinks that single case patterns should be on same line as case,
-- and no indent; all sane persons agree with him.
= let
ppr_alt (AlgAlts [] (BindDefault n _)) = ppBeside (pMinBndr pe n) (ppStr " ->")
ppr_alt (PrimAlts [] (BindDefault n _)) = ppBeside (pMinBndr pe n) (ppStr " ->")
ppr_alt (PrimAlts ((l, _):[]) NoDefault)= ppBeside (pLit pe l) (ppStr " ->")
ppr_alt (AlgAlts ((con, params, _):[]) NoDefault)
= ppCat [ppr_alt_con con (pCon pe con),
ppInterleave ppSP (map (pMinBndr pe) params),
ppStr "->"]
ppr_rhs (AlgAlts [] (BindDefault _ expr)) = ppr_expr pe expr
ppr_rhs (AlgAlts ((_,_,expr):[]) NoDefault) = ppr_expr pe expr
ppr_rhs (PrimAlts [] (BindDefault _ expr)) = ppr_expr pe expr
ppr_rhs (PrimAlts ((_,expr):[]) NoDefault) = ppr_expr pe expr
in
ppSep
[ppSep [ppPStr SLIT("case"), ppNest 4 (ppr_parend_expr pe expr), ppStr "of {", ppr_alt alts],
ppBeside (ppr_rhs alts) (ppStr "}")]
| otherwise -- default "case" printing
= ppSep
[ppSep [ppPStr SLIT("case"), ppNest 4 (ppr_parend_expr pe expr), ppStr "of {"],
ppNest 2 (ppr_alts pe alts),
......@@ -303,6 +325,15 @@ ppr_expr pe (Coerce c ty expr)
where
pp_coerce (CoerceIn v) = ppBeside (ppStr "{-in-}") (ppr (pStyle pe) v)
pp_coerce (CoerceOut v) = ppBeside (ppStr "{-out-}") (ppr (pStyle pe) v)
only_one_alt (AlgAlts [] (BindDefault _ _)) = True
only_one_alt (AlgAlts (_:[]) NoDefault) = True
only_one_alt (PrimAlts [] (BindDefault _ _)) = True
only_one_alt (PrimAlts (_:[]) NoDefault) = True
only_one_alt _ = False
ppr_alt_con con pp_con
= if isSymLexeme con then ppParens pp_con else pp_con
\end{code}
\begin{code}
......@@ -314,14 +345,11 @@ ppr_alts pe (AlgAlts alts deflt)
ppCat [ppParens (ppInterleave ppComma (map (pMinBndr pe) params)),
ppStr "->"]
else
ppCat [ppr_con con (pCon pe con),
ppCat [ppr_alt_con con (pCon pe con),
ppInterleave ppSP (map (pMinBndr pe) params),
ppStr "->"]
)
4 (ppr_expr pe expr)
where
ppr_con con pp_con
= if isSymLexeme con then ppParens pp_con else pp_con
ppr_alts pe (PrimAlts alts deflt)
= ppAboves [ ppAboves (map ppr_alt alts), ppr_default pe deflt ]
......
......@@ -38,7 +38,7 @@ import PprType ( GenType )
import PprStyle ( PprStyle(..) )
import Pretty ( ppShow )
import Type ( mkTyVarTys, mkForAllTys, splitSigmaTy,
tyVarsOfType, tyVarsOfTypes
tyVarsOfType, tyVarsOfTypes, isDictTy
)
import TyVar ( tyVarSetToList, GenTyVar{-instance Eq-} )
import Util ( isIn, panic, pprTrace{-ToDo:rm-} )
......@@ -46,8 +46,6 @@ import PprCore--ToDo:rm
import PprType ( GenTyVar ) --ToDo:rm
import Usage--ToDo:rm
import Unique--ToDo:rm
isDictTy = panic "DsBinds.isDictTy"
\end{code}
%************************************************************************
......
......@@ -16,7 +16,7 @@ We could either use this, or parameterise @GenCoreExpr@ on @Types@ and
module HsCore (
UnfoldingCoreExpr(..), UnfoldingCoreAlts(..),
UnfoldingCoreDefault(..), UnfoldingCoreBinding(..),
UnfoldingCoreAtom(..), UfId(..), UnfoldingType(..),
UnfoldingCoreAtom(..), UfId(..), SYN_IE(UnfoldingType),
UnfoldingPrimOp(..), UfCostCentre(..)
) where
......
......@@ -16,7 +16,6 @@ module HsSyn (
-- this module tells about "real Haskell"
EXP_MODULE(HsSyn) ,
#if (! defined(REALLY_HASKELL_1_3)) || PATRICK_FIXES_MODULE_DOTDOT_THING
EXP_MODULE(HsBinds) ,
EXP_MODULE(HsDecls) ,
EXP_MODULE(HsExpr) ,
......@@ -25,76 +24,6 @@ module HsSyn (
EXP_MODULE(HsMatches) ,
EXP_MODULE(HsPat) ,
EXP_MODULE(HsTypes)
#else
ArithSeqInfo(..),
BangType(..),
Bind(..),
ClassDecl(..),
ConDecl(..),
DefaultDecl(..),
FixityDecl(..),
GRHS(..),
GRHSsAndBinds(..),
HsBinds(..),
HsExpr(..),
HsLit(..),
IE(..),
ImportDecl(..),
InPat(..),
InstDecl(..),
Match(..),
MonoBinds(..),
MonoType(..),
OutPat(..),
PolyType(..),
Qualifier(..),
Sig(..),
SpecDataSig(..),
SpecInstSig(..),
Stmt(..),
TyDecl(..),
bindIsRecursive,
cmpContext,
cmpMonoType,
cmpPolyType,
collectBinders,
collectMonoBinders,
collectMonoBindersAndLocs,
collectPatBinders,
collectTopLevelBinders,
extractCtxtTyNames,
extractMonoTyNames,
failureFreePat,
irrefutablePat,
irrefutablePats,
isConPat,
isLitPat,
negLiteral,
nullBind,
nullBinds,
nullMonoBinds,
patsAreAllCons,
patsAreAllLits,
pp_condecls,
pp_decl_head,
pp_dotdot,
pp_rbinds,
pp_tydecl,
pprContext,
pprExpr,
pprGRHS,
pprGRHSsAndBinds,
pprMatch,
pprMatches,
pprParendExpr,
pprParendMonoType,
pprParendPolyType,
ppr_bang,
print_it,
SYN_IE(ClassAssertion),
SYN_IE(Context),
SYN_IE(HsRecordBinds)
#endif
) where
IMP_Ubiq()
......
......@@ -55,8 +55,6 @@ module CmdLineOpts (
opt_GranMacros,
opt_Haskell_1_3,
opt_HiMap,
opt_HideBuiltinNames,
opt_HideMostBuiltinNames,
opt_IgnoreIfacePragmas,
opt_IgnoreStrictnessPragmas,
opt_IrrefutableEverything,
......@@ -274,8 +272,6 @@ opt_ForConcurrent = lookUp SLIT("-fconcurrent")
opt_GranMacros = lookUp SLIT("-fgransim")
opt_GlasgowExts = lookUp SLIT("-fglasgow-exts")
opt_Haskell_1_3 = lookUp SLIT("-fhaskell-1.3")
opt_HideBuiltinNames = lookUp SLIT("-fhide-builtin-names")
opt_HideMostBuiltinNames = lookUp SLIT("-fmin-builtin-names")
opt_IgnoreStrictnessPragmas = lookUp SLIT("-fignore-strictness-pragmas")
opt_IrrefutableEverything = lookUp SLIT("-firrefutable-everything")
opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples")
......
......@@ -94,7 +94,7 @@ doIt (core_cmds, stg_cmds) input_pgm
renameModule rn_uniqs rdr_module >>=
\ (rn_mod, rn_env, import_names,
export_fn, usage_stuff,
export_stuff, usage_stuff,
rn_errs_bag, rn_warns_bag) ->
if (not (isEmptyBag rn_errs_bag)) then
......@@ -126,7 +126,7 @@ doIt (core_cmds, stg_cmds) input_pgm
startIface mod_name >>= \ if_handle ->
ifaceUsages if_handle usages_map >>
ifaceVersions if_handle version_info >>
ifaceExportList if_handle export_fn rn_mod >>
ifaceExportList if_handle export_stuff rn_env >>
ifaceFixities if_handle rn_mod >>
ifaceInstanceModules if_handle instance_modules >>
......
......@@ -27,14 +27,14 @@ import CmdLineOpts ( opt_ProduceHi )
import FieldLabel ( FieldLabel{-instance NamedThing-} )
import FiniteMap ( emptyFM, addToFM, lookupFM, fmToList, eltsFM, FiniteMap )
import HsSyn
import Id ( idType, dataConRawArgTys, dataConFieldLabels,
import Id ( idType, dataConRawArgTys, dataConFieldLabels, isDataCon,
dataConStrictMarks, StrictnessMark(..),
GenId{-instance NamedThing/Outputable-}
)
import Maybes ( maybeToBool )
import Name ( origName, nameOf, moduleOf,
exportFlagOn, nameExportFlag, ExportFlag(..),
isLexSym, isLocallyDefined, isWiredInName,
isLexSym, isLexCon, isLocallyDefined, isWiredInName,
RdrName(..){-instance Outputable-},
OrigName(..){-instance Ord-},
Name{-instance NamedThing-}
......@@ -44,10 +44,11 @@ import PprEnv -- not sure how much...
import PprStyle ( PprStyle(..) )
import PprType -- most of it (??)
--import PrelMods ( modulesWithBuiltins )
import PrelInfo ( builtinNameInfo )
import PrelInfo ( builtinValNamesMap, builtinTcNamesMap )
import Pretty ( prettyToUn )