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

partain 1.3 changes through 960629

ghc/compiler/Jmakefile

@@ -611,7 +611,7 @@ compile(reader/PrefixToHs,lhs,)
 compile(reader/ReadPrefix,lhs,if_ghc(-fvia-C -I$(COMPINFO_DIR) -Iparser '-#include"hspincl.h"'))
 compile(reader/RdrHsSyn,lhs,)
 
-compile(rename/ParseIface,hs,)
+compile(rename/ParseIface,hs,-Onot) /* sigh */
 compile(rename/ParseUtils,lhs,)
 compile(rename/RnHsSyn,lhs,)
 compile(rename/RnMonad,lhs,if_ghc(-fvia-C))

ghc/compiler/absCSyn/AbsCLoop_1_3.lhi

@@ -5,4 +5,17 @@ MachMisc fixedHdrSizeInWords (..)
 MachMisc varHdrSizeInWords   (..)
 CgRetConv ctrlReturnConvAlg (..)
 CgRetConv CtrlReturnConvention(..)
+ClosureInfo closureKind (..)
+ClosureInfo closureLabelFromCI (..)
+ClosureInfo closureNonHdrSize (..)
+ClosureInfo closurePtrsSize (..)
+ClosureInfo closureSMRep (..)
+ClosureInfo closureSemiTag (..)
+ClosureInfo closureSizeWithoutFixedHdr (..)
+ClosureInfo closureTypeDescr (..)
+ClosureInfo closureUpdReqd (..)
+ClosureInfo infoTableLabelFromCI (..)
+ClosureInfo maybeSelectorInfo (..)
+ClosureInfo entryLabelFromCI (..)
+ClosureInfo fastLabelFromCI (..)
 \end{code}

ghc/compiler/absCSyn/PprAbsC.lhs

@@ -20,6 +20,9 @@ module PprAbsC (
 
 IMP_Ubiq(){-uitous-}
 IMPORT_DELOOPER(AbsCLoop)		-- break its dependence on ClosureInfo
+IMPORT_1_3(IO(Handle))
+IMPORT_1_3(Char(isDigit,isPrint))
+IMPORT_1_3(GHCbase(Addr(..)) ) -- to see innards
 
 import AbsCSyn
 
@@ -35,7 +38,7 @@ import CmdLineOpts	( opt_SccProfilingOn )
 import CostCentre	( uppCostCentre, uppCostCentreDecl )
 import Costs		( costs, addrModeCosts, CostRes(..), Side(..) )
 import CStrings		( stringToC )
-import FiniteMap	( addToFM, emptyFM, lookupFM )
+import FiniteMap	( addToFM, emptyFM, lookupFM, FiniteMap )
 import HeapOffs		( isZeroOff, subOff, pprHeapOffset )
 import Literal		( showLiteral, Literal(..) )
 import Maybes		( maybeToBool, catMaybes )
@@ -799,7 +802,11 @@ process_casm results args string = process results args string
 	    _   -> panic ("process_casm: casm with many results while processing _casm_ \"" ++ string ++ "\".\n")
 
 	other ->
-	  case readDec other of
+	  let
+		read_int :: ReadS Int
+		read_int = reads
+	  in
+	  case (read_int other) of
 	    [(num,css)] ->
 		  if 0 <= num && num < length args
 		  then uppBeside (uppParens (args !! num))

ghc/compiler/basicTypes/IdInfo.lhs

@@ -83,6 +83,7 @@ import PprStyle		( PprStyle(..) )
 import Pretty
 import SrcLoc		( mkUnknownSrcLoc )
 import Type		( eqSimpleTy, splitFunTyExpandingDicts )
+import Unique		( pprUnique )
 import Util		( mapAccumL, panic, assertPanic, pprPanic )
 
 #ifdef REALLY_HASKELL_1_3
@@ -766,7 +767,7 @@ pp_unfolding sty for_this_id inline_env uf_details
     pp NoUnfoldingDetails = pp_NONE
 
     pp (MagicForm tag _)
-      = ppCat [ppPStr SLIT("_MF_"), ppPStr tag]
+      = ppCat [ppPStr SLIT("_MF_"), pprUnique tag]
 
     pp (GenForm _ _ BadUnfolding) = pp_NONE
 

ghc/compiler/basicTypes/IdLoop.lhi

@@ -70,7 +70,7 @@ data UnfoldingDetails
   | OtherLitForm [Literal]
   | OtherConForm [GenId (GenType (GenTyVar (GenUsage Unique)) Unique)]
   | GenForm FormSummary (GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique), BinderInfo) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique) UnfoldingGuidance
-  | MagicForm _PackedString MagicUnfoldingFun
+  | MagicForm Unique MagicUnfoldingFun
 
 data UnfoldingGuidance
   = UnfoldNever

ghc/compiler/basicTypes/IdUtils.lhs

@@ -20,7 +20,7 @@ import PrelMods		( gHC_BUILTINS )
 import PrimOp		( primOpInfo, tagOf_PrimOp, primOp_str,
 			  PrimOpInfo(..), PrimOpResultInfo(..) )
 import RnHsSyn		( RnName(..) )
-import Type		( mkForAllTys, mkFunTys, mkTyVarTy, applyTyCon )
+import Type		( mkForAllTys, mkFunTy, mkFunTys, mkTyVarTy, applyTyCon )
 import TysWiredIn	( boolTy )
 import Unique		( mkPrimOpIdUnique )
 import Util		( panic )
@@ -44,7 +44,7 @@ primOpId op
 	mk_prim_Id op str [] [ty,ty] (compare_fun_ty ty) 2
 
       Coercing str ty1 ty2 ->
-	mk_prim_Id op str [] [ty1] (mkFunTys [ty1] ty2) 1
+	mk_prim_Id op str [] [ty1] (ty1 `mkFunTy` ty2) 1
 
       PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
 	mk_prim_Id op str
@@ -72,7 +72,7 @@ primOpId op
 
 \begin{code}
 dyadic_fun_ty  ty = mkFunTys [ty, ty] ty
-monadic_fun_ty ty = mkFunTys [ty] ty
+monadic_fun_ty ty = ty `mkFunTy` ty
 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
 \end{code}
 

ghc/compiler/basicTypes/Unique.lhs

@@ -132,7 +132,6 @@ module Unique (
 	parIdKey,
 	patErrorIdKey,
 	primIoTyConKey,
-	primIoDataConKey,
 	ratioDataConKey,
 	ratioTyConKey,
 	rationalTyConKey,
@@ -590,7 +589,6 @@ stateDataConKey				= mkPreludeDataConUnique 39
 trueDataConKey				= mkPreludeDataConUnique 40
 wordDataConKey				= mkPreludeDataConUnique 41
 stDataConKey				= mkPreludeDataConUnique 42
-primIoDataConKey			= mkPreludeDataConUnique 43
 \end{code}
 
 %************************************************************************

ghc/compiler/codeGen/CgBindery.lhs

@@ -7,7 +7,7 @@
 #include "HsVersions.h"
 
 module CgBindery (
-	CgBindings(..), CgIdInfo(..){-dubiously concrete-},
+	SYN_IE(CgBindings), CgIdInfo(..){-dubiously concrete-},
 	StableLoc, VolatileLoc,
 
 	maybeAStkLoc, maybeBStkLoc,
@@ -34,7 +34,7 @@ import CgMonad
 
 import CgUsages		( getHpRelOffset, getSpARelOffset, getSpBRelOffset )
 import CLabel		( mkClosureLabel )
-import ClosureInfo	( mkLFImported, mkConLFInfo, mkLFArgument )
+import ClosureInfo	( mkLFImported, mkConLFInfo, mkLFArgument, LambdaFormInfo )
 import HeapOffs		( SYN_IE(VirtualHeapOffset),
 			  SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset)
 			)

ghc/compiler/codeGen/CgCase.lhs

@@ -63,8 +63,8 @@ import PrimRep		( getPrimRepSize, isFollowableRep, retPrimRepSize,
 			)
 import TyCon		( isEnumerationTyCon )
 import Type		( typePrimRep,
-			  getAppSpecDataTyConExpandingDicts, maybeAppSpecDataTyConExpandingDicts,
-			  isEnumerationTyCon
+			  getAppSpecDataTyConExpandingDicts,
+			  maybeAppSpecDataTyConExpandingDicts
 			)
 import Util		( sortLt, isIn, isn'tIn, zipEqual,
 			  pprError, panic, assertPanic

ghc/compiler/codeGen/CgClosure.lhs

@@ -24,15 +24,14 @@ import CgBindery	( getCAddrMode, getArgAmodes,
 			  getCAddrModeAndInfo, bindNewToNode,
 			  bindNewToAStack, bindNewToBStack,
 			  bindNewToReg, bindArgsToRegs,
-			  stableAmodeIdInfo, heapIdInfo
+			  stableAmodeIdInfo, heapIdInfo, CgIdInfo
 			)
 import CgCompInfo	( spARelToInt, spBRelToInt )
 import CgUpdate		( pushUpdateFrame )
 import CgHeapery	( allocDynClosure, heapCheck
 			  , heapCheckOnly, fetchAndReschedule, yield  -- HWL
 			)
-import CgRetConv	( mkLiveRegsMask,
-			  ctrlReturnConvAlg, dataReturnConvAlg, 
+import CgRetConv	( ctrlReturnConvAlg, dataReturnConvAlg, 
 			  CtrlReturnConvention(..), DataReturnConvention(..)
 			)
 import CgStackery	( getFinalStackHW, mkVirtStkOffsets,

ghc/compiler/codeGen/CgCon.lhs

@@ -26,7 +26,7 @@ import AbsCUtils	( mkAbstractCs, getAmodeRep )
 import CgBindery	( getArgAmodes, bindNewToNode,
 			  bindArgsToRegs, newTempAmodeAndIdInfo,
 			  idInfoToAmode, stableAmodeIdInfo,
-			  heapIdInfo
+			  heapIdInfo, CgIdInfo
 			)
 import CgClosure	( cgTopRhsClosure )
 import CgCompInfo	( mAX_INTLIKE, mIN_INTLIKE )

ghc/compiler/codeGen/CgConTbls.lhs

@@ -16,8 +16,7 @@ import CgMonad
 import AbsCUtils	( mkAbsCStmts, mkAbstractCs, magicIdPrimRep )
 import CgCompInfo	( uF_UPDATEE )
 import CgHeapery	( heapCheck, allocDynClosure )
-import CgRetConv	( mkLiveRegsMask,
-			  dataReturnConvAlg, ctrlReturnConvAlg,
+import CgRetConv	( dataReturnConvAlg, ctrlReturnConvAlg,
 			  CtrlReturnConvention(..),
 			  DataReturnConvention(..)
 			)
@@ -33,7 +32,7 @@ import ClosureInfo	( layOutStaticClosure, layOutDynCon,
 			  infoTableLabelFromCI, dataConLiveness
 			)
 import CostCentre	( dontCareCostCentre )
-import FiniteMap	( fmToList )
+import FiniteMap	( fmToList, FiniteMap )
 import HeapOffs		( zeroOff, SYN_IE(VirtualHeapOffset) )
 import Id		( dataConTag, dataConRawArgTys,
 			  dataConNumFields, fIRST_TAG,

ghc/compiler/codeGen/CgExpr.lhs

@@ -20,7 +20,7 @@ import CgMonad
 import AbsCSyn
 
 import AbsCUtils	( mkAbsCStmts, mkAbstractCs )
-import CgBindery	( getArgAmodes )
+import CgBindery	( getArgAmodes, CgIdInfo )
 import CgCase		( cgCase, saveVolatileVarsAndRegs )
 import CgClosure	( cgRhsClosure )
 import CgCon		( buildDynCon, cgReturnDataCon )

ghc/compiler/codeGen/CgHeapery.lhs

@@ -20,7 +20,6 @@ import AbsCSyn
 import CgMonad
 
 import AbsCUtils	( mkAbstractCs, getAmodeRep )
-import CgRetConv	( mkLiveRegsMask )
 import CgUsages		( getVirtAndRealHp, setVirtHp, setRealHp,
 			  initHeapUsage
 			)

ghc/compiler/codeGen/CgLetNoEscape.lhs

@@ -20,7 +20,8 @@ import CgMonad
 import AbsCSyn
 
 import CgBindery	( letNoEscapeIdInfo, bindArgsToRegs,
-			  bindNewToAStack, bindNewToBStack
+			  bindNewToAStack, bindNewToBStack,
+			  CgIdInfo
 			)
 import CgHeapery	( heapCheck )
 import CgRetConv	( assignRegs )

ghc/compiler/codeGen/CgLoop2_1_3.lhi

 \begin{code}
 interface CgLoop2_1_3 1
 __exports__
-Outputable Outputable (..)
+CgExpr cgExpr (..)
+CgExpr getPrimOpArgAmodes (..)
 \end{code}

ghc/compiler/codeGen/CgTailCall.lhs

@@ -34,7 +34,8 @@ import CgStackery	( adjustRealSps, mkStkAmodes )
 import CgUsages		( getSpARelOffset )
 import CLabel		( mkStdUpdCodePtrVecLabel, mkConUpdCodePtrVecLabel )
 import ClosureInfo	( nodeMustPointToIt,
-			  getEntryConvention, EntryConvention(..)
+			  getEntryConvention, EntryConvention(..),
+			  LambdaFormInfo
 			)
 import CmdLineOpts	( opt_DoSemiTagging )
 import HeapOffs		( zeroOff, SYN_IE(VirtualSpAOffset) )

ghc/compiler/codeGen/CodeGen.lhs

@@ -27,6 +27,7 @@ import AbsCSyn
 
 import AbsCUtils	( mkAbstractCs, mkAbsCStmts )
 import Bag		( foldBag )
+import CgBindery	( CgIdInfo )
 import CgClosure	( cgTopRhsClosure )
 import CgCon		( cgTopRhsCon )
 import CgConTbls	( genStaticConBits )
@@ -35,6 +36,7 @@ import CmdLineOpts	( opt_SccProfilingOn, opt_CompilingGhcInternals,
 			  opt_EnsureSplittableC, opt_SccGroup
 			)
 import CStrings		( modnameToC )
+import FiniteMap	( FiniteMap )
 import Maybes		( maybeToBool )
 import PrimRep		( getPrimRepSize, PrimRep(..) )
 import Util		( panic, assertPanic )

ghc/compiler/coreSyn/CoreUtils.lhs

@@ -50,7 +50,7 @@ import SrcLoc		( mkUnknownSrcLoc )
 import TyVar		( cloneTyVar,
 			  isNullTyVarEnv, addOneToTyVarEnv, SYN_IE(TyVarEnv)
 			)
-import Type		( mkFunTys, mkForAllTy, mkForAllUsageTy, mkTyVarTy,
+import Type		( mkFunTy, mkForAllTy, mkForAllUsageTy, mkTyVarTy,
 			  getFunTy_maybe, applyTy, isPrimType,
 			  splitSigmaTy, splitFunTy, eqTy, applyTypeEnvToTy
 			)
@@ -91,7 +91,7 @@ coreExprType (Con con args) = applyTypeToArgs (idType    con) args
 coreExprType (Prim op args) = applyTypeToArgs (primOpType op) args
 
 coreExprType (Lam (ValBinder binder) expr)
-  = mkFunTys [idType binder] (coreExprType expr)
+  = idType binder `mkFunTy` coreExprType expr
 
 coreExprType (Lam (TyBinder tyvar) expr)
   = mkForAllTy tyvar (coreExprType expr)

ghc/compiler/deSugar/Desugar.lhs

@@ -11,7 +11,7 @@ module Desugar ( deSugar, DsMatchContext, pprDsWarnings ) where
 IMP_Ubiq(){-uitous-}
 
 import HsSyn		( HsBinds, HsExpr )
-import TcHsSyn		( TypecheckedHsBinds(..), TypecheckedHsExpr(..) )
+import TcHsSyn		( SYN_IE(TypecheckedHsBinds), SYN_IE(TypecheckedHsExpr) )
 import CoreSyn
 
 import DsMonad

ghc/compiler/deSugar/DsBinds.lhs

@@ -18,9 +18,9 @@ IMPORT_DELOOPER(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(..),
-			  TypecheckedPat(..)
+import TcHsSyn		( SYN_IE(TypecheckedHsBinds), SYN_IE(TypecheckedHsExpr),
+			  SYN_IE(TypecheckedBind), SYN_IE(TypecheckedMonoBinds),
+			  SYN_IE(TypecheckedPat)
 			)
 import DsHsSyn		( collectTypedBinders, collectTypedPatBinders )
 

ghc/compiler/deSugar/DsExpr.lhs

@@ -16,9 +16,9 @@ import HsSyn		( failureFreePat,
 			  Stmt(..), Match(..), Qualifier, HsBinds, PolyType,
 			  GRHSsAndBinds
 			)
-import TcHsSyn		( TypecheckedHsExpr(..), TypecheckedHsBinds(..),
-			  TypecheckedRecordBinds(..), TypecheckedPat(..),
-			  TypecheckedStmt(..)
+import TcHsSyn		( SYN_IE(TypecheckedHsExpr), SYN_IE(TypecheckedHsBinds),
+			  SYN_IE(TypecheckedRecordBinds), SYN_IE(TypecheckedPat),
+			  SYN_IE(TypecheckedStmt)
 			)
 import CoreSyn
 
@@ -28,7 +28,7 @@ import DsHsSyn		( outPatType )
 import DsListComp	( dsListComp )
 import DsUtils		( mkAppDs, mkConDs, mkPrimDs, dsExprToAtom,
 			  mkErrorAppDs, showForErr, EquationInfo,
-			  MatchResult, DsCoreArg(..)
+			  MatchResult, SYN_IE(DsCoreArg)
 			)
 import Match		( matchWrapper )
 

ghc/compiler/deSugar/DsGRHSs.lhs

@@ -13,9 +13,9 @@ IMPORT_DELOOPER(DsLoop)		-- break dsExpr/dsBinds-ish loop
 
 import HsSyn		( GRHSsAndBinds(..), GRHS(..),
 			  HsExpr, HsBinds )
-import TcHsSyn		( TypecheckedGRHSsAndBinds(..), TypecheckedGRHS(..),
-			  TypecheckedPat(..), TypecheckedHsBinds(..),
-			  TypecheckedHsExpr(..)	)
+import TcHsSyn		( SYN_IE(TypecheckedGRHSsAndBinds), SYN_IE(TypecheckedGRHS),
+			  SYN_IE(TypecheckedPat), SYN_IE(TypecheckedHsBinds),
+			  SYN_IE(TypecheckedHsExpr)	)
 import CoreSyn		( SYN_IE(CoreBinding), SYN_IE(CoreExpr), mkCoLetsAny )
 
 import DsMonad
@@ -78,23 +78,21 @@ dsGRHSs ty kind pats (grhs:grhss)
     combineGRHSMatchResults match_result1 match_result2
 
 dsGRHS ty kind pats (OtherwiseGRHS expr locn)
-  = putSrcLocDs locn		 (
+  = putSrcLocDs locn $
     dsExpr expr 	`thenDs` \ core_expr ->
     let
 	expr_fn = \ ignore -> core_expr
     in
     returnDs (MatchResult CantFail ty expr_fn (DsMatchContext kind pats locn))
-    )
 
 dsGRHS ty kind pats (GRHS guard expr locn)
-  = putSrcLocDs locn		 (
+  = putSrcLocDs locn $
     dsExpr guard 	`thenDs` \ core_guard ->
     dsExpr expr  	`thenDs` \ core_expr  ->
     let
 	expr_fn = \ fail -> mkCoreIfThenElse core_guard core_expr fail
     in
     returnDs (MatchResult CanFail ty expr_fn (DsMatchContext kind pats locn))
-    )
 \end{code}
 
 

ghc/compiler/deSugar/DsHsSyn.lhs

@@ -12,8 +12,8 @@ IMP_Ubiq()
 
 import HsSyn		( OutPat(..), HsBinds(..), Bind(..), MonoBinds(..),
 			  Sig, HsExpr, GRHSsAndBinds, Match, HsLit )
-import TcHsSyn		( TypecheckedPat(..), TypecheckedBind(..), 
-			  TypecheckedMonoBinds(..) )
+import TcHsSyn		( SYN_IE(TypecheckedPat), SYN_IE(TypecheckedBind), 
+			  SYN_IE(TypecheckedMonoBinds) )
 
 import Id		( idType )
 import TysWiredIn	( mkListTy, mkTupleTy, unitTy )

ghc/compiler/deSugar/DsListComp.lhs

@@ -12,7 +12,7 @@ IMP_Ubiq()
 IMPORT_DELOOPER(DsLoop)		-- break dsExpr-ish loop
 
 import HsSyn		( Qualifier(..), HsExpr, HsBinds )
-import TcHsSyn		( TypecheckedQual(..), TypecheckedHsExpr(..) , TypecheckedHsBinds(..) )
+import TcHsSyn		( SYN_IE(TypecheckedQual), SYN_IE(TypecheckedHsExpr) , SYN_IE(TypecheckedHsBinds) )
 import DsHsSyn		( outPatType )
 import CoreSyn
 
@@ -22,7 +22,7 @@ import DsUtils
 import CmdLineOpts	( opt_FoldrBuildOn )
 import CoreUtils	( coreExprType, mkCoreIfThenElse )
 import PrelVals		( mkBuild, foldrId )
-import Type		( mkTyVarTy, mkForAllTy, mkFunTys )
+import Type		( mkTyVarTy, mkForAllTy, mkFunTys, mkFunTy )
 import TysPrim		( alphaTy )
 import TysWiredIn	( nilDataCon, consDataCon, listTyCon )
 import TyVar		( alphaTyVar )
@@ -49,11 +49,14 @@ dsListComp expr quals
     else -- foldr/build lives!
 	new_alpha_tyvar		    `thenDs` \ (n_tyvar, n_ty) ->
 	let
-	    alpha_to_alpha = mkFunTys [alphaTy] alphaTy
+	    alpha_to_alpha = alphaTy `mkFunTy` alphaTy
 
 	    c_ty = mkFunTys [expr_ty, n_ty] n_ty
 	    g_ty = mkForAllTy alphaTyVar (
-			(mkFunTys [expr_ty, alpha_to_alpha] alpha_to_alpha))
+			(expr_ty `mkFunTy` alpha_to_alpha)
+			`mkFunTy` 
+			alpha_to_alpha
+		   )
 	in
 	newSysLocalsDs [c_ty,n_ty,g_ty]  `thenDs` \ [c, n, g] ->
 
@@ -138,7 +141,7 @@ deListComp expr ((GeneratorQual pat list1):quals) core_list2 -- rule A' above
 	u2_ty = outPatType pat
 
 	res_ty = coreExprType core_list2
-	h_ty = mkFunTys [u1_ty] res_ty
+	h_ty   = u1_ty `mkFunTy` res_ty
     in
     newSysLocalsDs [h_ty, u1_ty, u2_ty, u3_ty]
 				    `thenDs` \ [h', u1, u2, u3] ->

ghc/compiler/deSugar/DsLoop_1_3.lhi

 \begin{code}
 interface DsLoop_1_3 1
 __exports__
-Outputable Outputable (..)
+Match match (..)
+Match matchSimply (..)
+DsBinds	dsBinds (..)
+DsExpr	dsExpr (..)
 \end{code}

ghc/compiler/deSugar/DsMonad.lhs

@@ -7,7 +7,7 @@
 #include "HsVersions.h"
 
 module DsMonad (
-	DsM(..),
+	SYN_IE(DsM),
 	initDs, returnDs, thenDs, andDs, mapDs, listDs,
 	mapAndUnzipDs, zipWithDs,
 	uniqSMtoDsM,
@@ -17,7 +17,7 @@ module DsMonad (
 	getSrcLocDs, putSrcLocDs,
 	getModuleAndGroupDs,
 	extendEnvDs, lookupEnvDs, lookupEnvWithDefaultDs,
-	DsIdEnv(..),
+	SYN_IE(DsIdEnv),
 	lookupId,
 
 	dsShadowError,
@@ -38,7 +38,7 @@ import PprType		( GenType, GenTyVar )
 import PprStyle		( PprStyle(..) )
 import Pretty
 import SrcLoc		( unpackSrcLoc, mkUnknownSrcLoc, SrcLoc )
-import TcHsSyn		( TypecheckedPat(..) )
+import TcHsSyn		( SYN_IE(TypecheckedPat) )
 import TyVar		( nullTyVarEnv, cloneTyVar, GenTyVar{-instance Eq-} )
 import Unique		( Unique{-instances-} )
 import UniqSupply	( splitUniqSupply, getUnique, getUniques,

ghc/compiler/deSugar/DsUtils.lhs

@@ -13,7 +13,7 @@ module DsUtils (
 
 	combineGRHSMatchResults,
 	combineMatchResults,
-	dsExprToAtom, DsCoreArg(..),
+	dsExprToAtom, SYN_IE(DsCoreArg),
 	mkCoAlgCaseMatchResult,
 	mkAppDs, mkConDs, mkPrimDs, mkErrorAppDs,
 	mkCoLetsMatchResult,
@@ -32,7 +32,7 @@ IMPORT_DELOOPER(DsLoop)		( match, matchSimply )
 
 import HsSyn		( HsExpr(..), OutPat(..), HsLit(..),
 			  Match, HsBinds, Stmt, Qualifier, PolyType, ArithSeqInfo )
-import TcHsSyn		( TypecheckedPat(..) )
+import TcHsSyn		( SYN_IE(TypecheckedPat) )
 import DsHsSyn		( outPatType )
 import CoreSyn
 
@@ -47,7 +47,7 @@ import Id		( idType, dataConArgTys, mkTupleCon,
 			  SYN_IE(DataCon), SYN_IE(DictVar), SYN_IE(Id), GenId )
 import Literal		( Literal(..) )
 import TyCon		( mkTupleTyCon, isNewTyCon, tyConDataCons )
-import Type		( mkTyVarTys, mkRhoTy, mkForAllTys, mkFunTys,
+import Type		( mkTyVarTys, mkRhoTy, mkForAllTys, mkFunTy,
 			  mkTheta, isUnboxedType, applyTyCon, getAppTyCon
 			)
 import TysPrim		( voidTy )
@@ -578,7 +578,7 @@ mkFailurePair :: Type		-- Result type of the whole case expression
 				-- applied to unit tuple
 mkFailurePair ty
   | isUnboxedType ty
-  = newFailLocalDs (mkFunTys [voidTy] ty)	`thenDs` \ fail_fun_var ->
+  = newFailLocalDs (voidTy `mkFunTy` ty)	`thenDs` \ fail_fun_var ->
     newSysLocalDs voidTy			`thenDs` \ fail_fun_arg ->
     returnDs (\ body ->
 		NonRec fail_fun_var (Lam (ValBinder fail_fun_arg) body),

ghc/compiler/deSugar/Match.lhs

@@ -13,8 +13,8 @@ IMPORT_DELOOPER(DsLoop)		-- here for paranoia-checking reasons
 			-- and to break dsExpr/dsBinds-ish loop
 
 import HsSyn		hiding ( collectBinders{-also from CoreSyn-} )
-import TcHsSyn		( TypecheckedPat(..), TypecheckedMatch(..),
-			  TypecheckedHsBinds(..), TypecheckedHsExpr(..)	)
+import TcHsSyn		( SYN_IE(TypecheckedPat), SYN_IE(TypecheckedMatch),
+			  SYN_IE(TypecheckedHsBinds), SYN_IE(TypecheckedHsExpr)	)
 import DsHsSyn		( outPatType, collectTypedPatBinders )
 import CoreSyn
 

ghc/compiler/deSugar/MatchLit.lhs

@@ -13,8 +13,8 @@ IMPORT_DELOOPER(DsLoop)		-- break match-ish and dsExpr-ish loops
 
 import HsSyn		( HsLit(..), OutPat(..), HsExpr(..),
 			  Match, HsBinds, Stmt, Qualifier, PolyType, ArithSeqInfo )
-import TcHsSyn		( TypecheckedHsExpr(..), TypecheckedHsBinds(..),
-			  TypecheckedPat(..)
+import TcHsSyn		( SYN_IE(TypecheckedHsExpr), SYN_IE(TypecheckedHsBinds),
+			  SYN_IE(TypecheckedPat)
 			)
 import CoreSyn		( SYN_IE(CoreExpr), SYN_IE(CoreBinding) )
 

ghc/compiler/main/Main.lhs

@@ -9,6 +9,7 @@
 module Main ( main ) where
 
 IMP_Ubiq(){-uitous-}
+IMPORT_1_3(IO(hGetContents,stdin,stderr,hPutStr,hClose,openFile,IOMode(..)))
 
 import HsSyn
 

ghc/compiler/main/MkIface.lhs

@@ -19,17 +19,19 @@ module MkIface (
     ) where
 
 IMP_Ubiq(){-uitous-}
+IMPORT_1_3(IO(Handle,hPutStr,openFile,hClose,IOMode(..)))
 
-import Bag		( emptyBag, snocBag, bagToList )
+import Bag		( bagToList )
 import Class		( GenClass(..){-instance NamedThing-}, GenClassOp(..) )
 import CmdLineOpts	( opt_ProduceHi )
 import FieldLabel	( FieldLabel{-instance NamedThing-} )
-import FiniteMap	( fmToList, eltsFM )
+import FiniteMap	( emptyFM, addToFM, lookupFM, fmToList, eltsFM, FiniteMap )
 import HsSyn
 import Id		( idType, dataConRawArgTys, dataConFieldLabels,
 			  dataConStrictMarks, StrictnessMark(..),
 			  GenId{-instance NamedThing/Outputable-}
 			)
+import Maybes		( maybeToBool )
 import Name		( origName, nameOf, moduleOf,
 			  exportFlagOn, nameExportFlag, ExportFlag(..),
 			  isLexSym, isLocallyDefined, isWiredInName,
@@ -45,12 +47,12 @@ import PprType		-- most of it (??)
 import PrelInfo		( builtinNameInfo )
 import Pretty		( prettyToUn )
 import Unpretty		-- ditto
-import RnHsSyn		( RenamedHsModule(..), RnName{-instance NamedThing-} )
-import TcModule		( TcIfaceInfo(..) )
+import RnHsSyn		( isRnConstr, SYN_IE(RenamedHsModule), RnName{-instance NamedThing-} )
+import TcModule		( SYN_IE(TcIfaceInfo) )
 import TcInstUtil	( InstInfo(..) )
 import TyCon		( TyCon(..){-instance NamedThing-}, NewOrData(..) )
 import Type		( mkSigmaTy, mkDictTy, getAppTyCon, splitForAllTy )
-import Util		( sortLt, zipWithEqual, zipWith3Equal, assertPanic, panic{-ToDo:rm-}, pprTrace{-ToDo:rm-} )
+import Util		( sortLt, removeDups, zipWithEqual, zipWith3Equal, assertPanic, panic{-ToDo:rm-}, pprTrace{-ToDo:rm-} )
 
 uppSemid   x = uppBeside (prettyToUn (ppr PprInterface x)) uppSemi -- micro util
 ppr_ty	  ty = prettyToUn (pprType PprInterface ty)
@@ -189,24 +191,23 @@ ifaceExportList (Just if_hdl)
   = let
 	(vals_wired, tcs_wired)
 	  = case builtinNameInfo of { ((vals_fm,tcs_fm), _, _) ->
-	    ([ getName rn | rn <- eltsFM vals_fm ]
-	    ,[ getName rn | rn <- eltsFM tcs_fm  ]) }
+	    (eltsFM vals_fm, eltsFM tcs_fm) }
 
-	name_flag_pairs :: Bag (OrigName, ExportFlag)
+	name_flag_pairs :: FiniteMap OrigName ExportFlag
 	name_flag_pairs
-	  = foldr from_wired
-	   (foldr from_wired
+	  = foldr (from_wired True{-val-ish-})
+	   (foldr (from_wired False{-tycon-ish-})
 	   (foldr from_ty
 	   (foldr from_cls
 	   (foldr from_sig
-	   (from_binds binds emptyBag{-init accum-})
+	   (from_binds binds emptyFM{-init accum-})
 	     sigs)
 	     classdecls)
 	     typedecls)
 	     tcs_wired)
 	     vals_wired
 
-	sorted_pairs = sortLt lexical_lt (bagToList name_flag_pairs)
+	sorted_pairs = sortLt lexical_lt (fmToList name_flag_pairs)
 
     in
     hPutStr if_hdl "\n__exports__\n" >>
@@ -223,21 +224,33 @@ ifaceExportList (Just if_hdl)
     from_binds bs acc = maybe_add_list acc (collectTopLevelBinders bs)
 
     --------------
-    from_wired n acc
-      | exportFlagOn ef = acc `snocBag` (origName "maybe_add" n, ef)
+    from_wired is_val_ish rn acc
+      | on_in_acc	= acc -- if already in acc (presumably from real decl),
+			      -- don't take the dubious export flag from the