[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