[project @ 1997-07-05 02:55:34 by sof]

5f34bb74 · sof · 8d6910cb · 5f34bb74 · 5f34bb74 · 5f34bb74
Commit 5f34bb74 authored Jul 05, 1997 by sof
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ b/ghc/compiler/prelude/PrelInfo.lhs
@@ -52,8 +52,9 @@ import TysWiredIn
 -- others:
 import SpecEnv		( SpecEnv )
 import RdrHsSyn		( RdrName(..), varQual, tcQual, qual )
+import BasicTypes	( IfaceFlavour )
 import Id		( GenId, SYN_IE(Id) )
-import Name		( Name, OccName(..), DefnInfo(..), Provenance(..),
+import Name		( Name, OccName(..), Provenance(..),
 			  getName, mkGlobalName, modAndOcc )
 import Class		( Class(..), GenClass, classKey )
 import TyCon		( tyConDataCons, mkFunTyCon, TyCon )
@@ -250,7 +251,8 @@ Ids, Synonyms, Classes and ClassOps with builtin keys.

 \begin{code}
 mkKnownKeyGlobal :: (RdrName, Unique) -> Name
-mkKnownKeyGlobal (Qual mod occ, uniq) = mkGlobalName uniq mod occ VanillaDefn Implicit
+mkKnownKeyGlobal (Qual mod occ hif, uniq)
+  = mkGlobalName uniq mod occ (Implicit hif)

 allClass_NAME    = mkKnownKeyGlobal (allClass_RDR,   allClassKey)
 main_NAME	 = mkKnownKeyGlobal (main_RDR,	     mainKey)

--- a/ghc/compiler/prelude/PrelVals.lhs
+++ b/ghc/compiler/prelude/PrelVals.lhs
@@ -525,7 +525,7 @@ runSTId
    id_info
      = noIdInfo
 	`addArityInfo` exactArity 1
-	`addStrictnessInfo` mkStrictnessInfo [WwStrict] Nothing
+	`addStrictnessInfo` mkStrictnessInfo [WwStrict] False
 	`addArgUsageInfo` mkArgUsageInfo [ArgUsage 1]
 	-- ABSOLUTELY NO UNFOLDING, e.g.: (mk_inline_unfolding run_ST_template)
 	-- see example below
@@ -601,7 +601,7 @@ buildId
  = pcMiscPrelId buildIdKey gHC_ERR SLIT("build") buildTy
 	((((noIdInfo
 		{-LATER:`addUnfoldInfo` mkMagicUnfolding buildIdKey-})
-		`addStrictnessInfo` mkStrictnessInfo [WwStrict] Nothing)
+		`addStrictnessInfo` mkStrictnessInfo [WwStrict] False)
 		`addArgUsageInfo` mkArgUsageInfo [ArgUsage 2])
 		`addSpecInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
 	-- cheating, but since _build never actually exists ...
@@ -646,7 +646,7 @@ augmentId
  = pcMiscPrelId augmentIdKey gHC_ERR SLIT("augment") augmentTy
 	(((noIdInfo
 		{-LATER:`addUnfoldInfo` mkMagicUnfolding augmentIdKey-})
-		`addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
+		`addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] False)
 		`addArgUsageInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
 	-- cheating, but since _augment never actually exists ...
  where
@@ -669,7 +669,7 @@ foldrId = pcMiscPrelId foldrIdKey pREL_BASE SLIT("foldr")

 	idInfo = (((((noIdInfo
 			{-LATER:`addUnfoldInfo` mkMagicUnfolding foldrIdKey-})
-			`addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
+			`addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] False)
 			`addArityInfo` exactArity 3)
 			`addUpdateInfo` mkUpdateInfo [2,2,1])
 			`addSpecInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
@@ -683,7 +683,7 @@ foldlId = pcMiscPrelId foldlIdKey pREL_LIST SLIT("foldl")

 	idInfo = (((((noIdInfo
 			{-LATER:`addUnfoldInfo` mkMagicUnfolding foldlIdKey-})
-			`addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
+			`addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] False)
 			`addArityInfo` exactArity 3)
 			`addUpdateInfo` mkUpdateInfo [2,2,1])
 			`addSpecInfo` pcGenerateSpecs foldlIdKey foldlId noIdInfo{-ToDo-} foldlTy)
@@ -709,7 +709,7 @@ appendId
      (mkSigmaTy [alphaTyVar] []
 	    (mkFunTys [mkListTy alphaTy, mkListTy alphaTy] (mkListTy alphaTy)))
    idInfo = (((noIdInfo
-		`addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
+		`addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] False)
 		`addArityInfo` exactArity 2)
 		`addUpdateInfo` mkUpdateInfo [1,2])
 -}

--- a/ghc/compiler/prelude/StdIdInfo.lhs
+++ b/ghc/compiler/prelude/StdIdInfo.lhs
@@ -21,6 +21,7 @@ module StdIdInfo (
 IMP_Ubiq()

 import Type
+import TyVar		( alphaTyVar )
 import CmdLineOpts      ( opt_PprUserLength )
 import CoreSyn
 import Literal
@@ -36,7 +37,7 @@ import Id		( GenId, mkTemplateLocals, idType,
 			  SYN_IE(Id)
 			)
 import IdInfo		( ArityInfo, exactArity )
-import Class		( GenClass, GenClassOp, classSig, classOpLocalType )
+import Class		( GenClass, classBigSig, classDictArgTys )
 import TyCon		( isNewTyCon, isDataTyCon, isAlgTyCon )
 import FieldLabel	( FieldLabel )
 import PrelVals		( pAT_ERROR_ID )
@@ -187,41 +188,17 @@ addStandardIdInfo sel_id
 \begin{code}
 addStandardIdInfo sel_id
  | maybeToBool maybe_sc_sel_id
-  = sel_id `addIdUnfolding` unfolding
-	-- The always-inline thing means we don't need any other IdInfo
+  = sel_id `addIdUnfolding` (mk_selector_unfolding cls sel_id)
  where
    maybe_sc_sel_id    = isSuperDictSelId_maybe sel_id
-    Just (cls, the_sc) = maybe_sc_sel_id
-
-    unfolding = mkUnfolding IWantToBeINLINEd {- Always inline selectors -} rhs
-    rhs	      = mk_dict_selector [tyvar] dict_id arg_ids the_arg_id
-
-    (tyvar, scs, ops)  = classSig cls
-    tyvar_ty	       = mkTyVarTy tyvar
-    [dict_id]	       = mkTemplateLocals [mkDictTy cls tyvar_ty]
-    arg_ids	       = mkTemplateLocals ([mkDictTy sc tyvar_ty | sc <- scs] ++
-					   map classOpLocalType ops)
-    the_arg_id	       = assoc "StdIdInfoSC" (scs `zip` arg_ids) the_sc
+    Just (cls, _) = maybe_sc_sel_id

 addStandardIdInfo sel_id
  | maybeToBool maybe_meth_sel_id
-  = sel_id `addIdUnfolding` unfolding
-	-- The always-inline thing means we don't need any other IdInfo
+  = sel_id `addIdUnfolding` (mk_selector_unfolding cls sel_id)
  where
    maybe_meth_sel_id  = isMethodSelId_maybe sel_id
-    Just (cls, the_op) = maybe_meth_sel_id
-
-    unfolding = mkUnfolding IWantToBeINLINEd {- Always inline selectors -} rhs
-    rhs       = mk_dict_selector [tyvar] dict_id arg_ids the_arg_id
-
-    (tyvar, scs, ops) = classSig cls
-    n_scs	      = length scs
-    tyvar_ty	      = mkTyVarTy tyvar
-    [dict_id]	      = mkTemplateLocals [mkDictTy cls tyvar_ty]
-    arg_ids	      = mkTemplateLocals ([mkDictTy sc tyvar_ty | sc <- scs] ++
-					  map classOpLocalType ops)
-					  
-    the_arg_id	      = assoc "StdIdInfoMeth" (ops `zip` (drop n_scs arg_ids)) the_op
+    Just cls = maybe_meth_sel_id
 \end{code}


@@ -275,6 +252,19 @@ Selecting a field for a dictionary.  If there is just one field, then
 there's nothing to do.

 \begin{code}
+mk_selector_unfolding clas sel_id
+  = mkUnfolding IWantToBeINLINEd {- Always inline selectors -} rhs
+	-- The always-inline thing means we don't need any other IdInfo
+  where
+    rhs	       = mk_dict_selector [alphaTyVar] dict_id arg_ids the_arg_id
+    tyvar_ty   = mkTyVarTy alphaTyVar
+    [dict_id]  = mkTemplateLocals [mkDictTy clas tyvar_ty]
+    arg_tys    = classDictArgTys clas tyvar_ty
+    arg_ids    = mkTemplateLocals arg_tys
+    the_arg_id = assoc "StdIdInfo:mk_sel" ((sc_sel_ids ++ op_sel_ids) `zip` arg_ids) sel_id
+
+    (_, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas
+
 mk_dict_selector tyvars dict_id [arg_id] the_arg_id
  = mkLam tyvars [dict_id] (Var dict_id)


--- a/ghc/compiler/prelude/TysWiredIn.hi-boot
+++ b/ghc/compiler/prelude/TysWiredIn.hi-boot
@@ -2,5 +2,5 @@ _interface_ TysWiredIn 1
 _exports_
 TysWiredIn tupleCon tupleTyCon;
 _declarations_
-1 tupleCon _:_ PrelBase.Int -> Id.Id ;;
-1 tupleTyCon _:_ PrelBase.Int -> TyCon.TyCon ;;
+1 tupleCon _:_ BasicTypes.Arity -> Id.Id ;;
+1 tupleTyCon _:_ BasicTypes.Arity -> TyCon.TyCon ;;
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -94,8 +94,6 @@ IMPORT_DELOOPER(IdLoop)	( SpecEnv, nullSpecEnv,
 #else
 import {-# SOURCE #-} Id ( Id, mkDataCon, mkTupleCon, StrictnessMark(..) )
 import {-# SOURCE #-} SpecEnv ( SpecEnv, nullSpecEnv )
-import {-# SOURCE #-} Type ( Type )
-import {-# SOURCE #-} TyVar ( TyVar )
 #endif

 -- friends:
@@ -103,16 +101,17 @@ import PrelMods
 import TysPrim

 -- others:
+import FieldLabel	()	--
 import Kind		( mkBoxedTypeKind, mkArrowKind )
-import Name		--( mkWiredInTyConName, mkWiredInIdName, mkTupNameStr )
+import Name		( mkWiredInTyConName, mkWiredInIdName )
 import TyCon		( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
 			  TyCon, SYN_IE(Arity)
 			)
-import BasicTypes	( NewOrData(..) )
-import Type		( mkTyConTy, applyTyCon, mkSigmaTy, mkTyVarTys, 
+import BasicTypes	( SYN_IE(Module), NewOrData(..) )
+import Type		( SYN_IE(Type), mkTyConTy, applyTyCon, mkSigmaTy, mkTyVarTys, 
 			  mkFunTy, mkFunTys, maybeAppTyCon,
 			  GenType(..), SYN_IE(ThetaType), SYN_IE(TauType) )
-import TyVar		( tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
+import TyVar		( SYN_IE(TyVar), tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
 import Lex		( mkTupNameStr )
 import Unique
 import Util		( assoc, panic )

--- a/ghc/compiler/reader/Lex.lhs
+++ b/ghc/compiler/reader/Lex.lhs
@@ -34,7 +34,7 @@ import PrelBase ( Char(..) )
 import CmdLineOpts	( opt_IgnoreIfacePragmas )
 import Demand		( Demand(..) {- instance Read -} )
 import UniqFM           ( UniqFM, listToUFM, lookupUFM)
-import BasicTypes	( NewOrData(..) )
+import BasicTypes	( NewOrData(..), IfaceFlavour(..) )

 #if __GLASGOW_HASKELL__ >= 202
 import Maybes		( MaybeErr(..) )
@@ -205,10 +205,10 @@ data IfaceToken
  | ITconid   FAST_STRING
  | ITvarsym  FAST_STRING
  | ITconsym  FAST_STRING
-  | ITqvarid  (FAST_STRING,FAST_STRING)
-  | ITqconid  (FAST_STRING,FAST_STRING)
-  | ITqvarsym (FAST_STRING,FAST_STRING)
-  | ITqconsym (FAST_STRING,FAST_STRING)
+  | ITqvarid  (FAST_STRING,FAST_STRING,IfaceFlavour)
+  | ITqconid  (FAST_STRING,FAST_STRING,IfaceFlavour)
+  | ITqvarsym (FAST_STRING,FAST_STRING,IfaceFlavour)
+  | ITqconsym (FAST_STRING,FAST_STRING,IfaceFlavour)

  | ITidinfo [IfaceToken]  -- lazily return the stream of tokens for
 		           -- the info attached to an id.
@@ -624,15 +624,19 @@ lex_id buf =
 case expandWhile (is_mod_char) buf of
   buf' ->
    case currentChar# buf' of
-     '.'# ->
+     '.'# -> munch buf' HiFile
+     '!'# -> munch buf' HiBootFile
+     _    -> lex_id2 Nothing buf'
+   where
+    munch buf' hif = 
 	if not (emptyLexeme buf') then
 --	   _trace ("lex_id: "++(C# (currentChar# (stepOverLexeme buf'))):show (lexemeToFastString buf')) $ 
 	   case lexemeToFastString buf' of
-	     l@(FastString u# l# ba#) -> lex_id2 (Just (FastString u# l# ba#)) 
+	     l@(FastString u# l# ba#) -> lex_id2 (Just (FastString u# l# ba#, hif)) 
 	     					 (stepOn (stepOverLexeme buf'))
 	else
 	   lex_id2 Nothing buf'		
-     _  -> lex_id2 Nothing buf'
+	

 -- Dealt with the Module.part
 lex_id2 module_dot buf =
@@ -719,14 +723,14 @@ mk_var_token pk_str =
 -}
 			    
 end_lex_id Nothing token buf  = token : lexIface buf
-end_lex_id (Just m) token buf =
+end_lex_id (Just (m,hif)) token buf =
 case token of
-   ITconid n  -> ITqconid  (m,n)         : lexIface buf
-   ITvarid n  -> ITqvarid  (m,n)         : lexIface buf
-   ITconsym n -> ITqconsym (m,n)         : lexIface buf
-   ITvarsym n -> ITqvarsym (m,n)         : lexIface buf
-   ITbang     -> ITqvarsym (m,SLIT("!")) : lexIface buf
-   _	      -> ITunknown (show token)  : lexIface buf
+   ITconid n  -> ITqconid  (m,n,hif)         : lexIface buf
+   ITvarid n  -> ITqvarid  (m,n,hif)         : lexIface buf
+   ITconsym n -> ITqconsym (m,n,hif)         : lexIface buf
+   ITvarsym n -> ITqvarsym (m,n,hif)         : lexIface buf
+   ITbang     -> ITqvarsym (m,SLIT("!"),hif) : lexIface buf
+   _	      -> ITunknown (show token)      : lexIface buf

 ------------
 ifaceKeywordsFM :: UniqFM IfaceToken

--- a/ghc/compiler/reader/PrefixSyn.lhs
+++ b/ghc/compiler/reader/PrefixSyn.lhs
@@ -27,6 +27,7 @@ IMPORT_1_3(Char(isDigit))

 import HsSyn
 import RdrHsSyn
+import BasicTypes	( IfaceFlavour )
 import Util		( panic )
 import SrcLoc           ( SrcLoc )


--- a/ghc/compiler/reader/PrefixToHs.lhs
+++ b/ghc/compiler/reader/PrefixToHs.lhs
@@ -45,7 +45,7 @@ cvValSig (RdrTySig vars poly_ty src_loc)
  = [ Sig v poly_ty src_loc | v <- vars ]

 cvClassOpSig (RdrTySig vars poly_ty src_loc)
-  = [ ClassOpSig v v poly_ty src_loc | v <- vars ]
+  = [ ClassOpSig v Nothing poly_ty src_loc | v <- vars ]

 cvInstDeclSig (RdrSpecValSig        sigs) = sigs
 cvInstDeclSig (RdrInlineValSig      sig)  = [ sig ]

--- a/ghc/compiler/reader/RdrHsSyn.lhs
+++ b/ghc/compiler/reader/RdrHsSyn.lhs
@@ -46,7 +46,7 @@ module RdrHsSyn (
 	extractHsTyVars,

 	RdrName(..),
-	qual, varQual, tcQual, varUnqual,
+	qual, varQual, tcQual, varUnqual, lexVarQual, lexTcQual,
 	dummyRdrVarName, dummyRdrTcName,
 	isUnqual, isQual,
 	showRdr, rdrNameOcc, ieOcc,
@@ -60,7 +60,7 @@ IMP_Ubiq()
 import HsSyn
 import Lex
 import PrelMods		( pRELUDE )
-import BasicTypes	( Module(..), NewOrData )
+import BasicTypes	( Module(..), NewOrData, IfaceFlavour(..) )
 import Name		( ExportFlag(..), pprModule,
 			  OccName(..), pprOccName, 
 			  prefixOccName, SYN_IE(NamedThing) )
@@ -138,7 +138,7 @@ extractHsTyVars ty
 				     where
 				       locals = map getTyVarName tvs

-    insert (Qual _ _)	      acc = acc
+    insert (Qual _ _ _)	      acc = acc
    insert (Unqual (TCOcc _)) acc = acc
    insert other 	      acc | other `elem` acc = acc
 				  | otherwise	     = other : acc
@@ -162,11 +162,15 @@ mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
 \begin{code}
 data RdrName
  = Unqual OccName
-  | Qual   Module OccName
+  | Qual   Module OccName IfaceFlavour	-- HiBootFile for M!.t (interface files only), 
+					-- HiFile for the common M.t

-qual     (m,n) = Qual m n
-tcQual   (m,n) = Qual m (TCOcc n)
-varQual  (m,n) = Qual m (VarOcc n)
+qual     (m,n) = Qual m n HiFile
+tcQual   (m,n) = Qual m (TCOcc n) HiFile
+varQual  (m,n) = Qual m (VarOcc n) HiFile
+
+lexTcQual  (m,n,hif) = Qual m (TCOcc n) hif
+lexVarQual (m,n,hif) = Qual m (VarOcc n) hif

 	-- This guy is used by the reader when HsSyn has a slot for
 	-- an implicit name that's going to be filled in by
@@ -178,26 +182,26 @@ dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))

 varUnqual n = Unqual (VarOcc n)

-isUnqual (Unqual _) = True
-isUnqual (Qual _ _) = False
+isUnqual (Unqual _)   = True
+isUnqual (Qual _ _ _) = False

-isQual (Unqual _) = False
-isQual (Qual _ _) = True
+isQual (Unqual _)   = False
+isQual (Qual _ _ _) = True

 	-- Used for adding a prefix to a RdrName
 prefixRdrName :: FAST_STRING -> RdrName -> RdrName
-prefixRdrName prefix (Qual m n) = Qual m (prefixOccName prefix n)
-prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
+prefixRdrName prefix (Qual m n hif) = Qual m (prefixOccName prefix n) hif
+prefixRdrName prefix (Unqual n)     = Unqual (prefixOccName prefix n)

-cmpRdr (Unqual  n1) (Unqual  n2) = n1 `cmp` n2
-cmpRdr (Unqual  n1) (Qual m2 n2) = LT_
-cmpRdr (Qual m1 n1) (Unqual  n2) = GT_
-cmpRdr (Qual m1 n1) (Qual m2 n2) = (n1 `cmp` n2) `thenCmp` (_CMP_STRING_ m1 m2)
+cmpRdr (Unqual  n1) (Unqual  n2)     = n1 `cmp` n2
+cmpRdr (Unqual  n1) (Qual m2 n2 _)   = LT_
+cmpRdr (Qual m1 n1 _) (Unqual  n2)   = GT_
+cmpRdr (Qual m1 n1 _) (Qual m2 n2 _) = (n1 `cmp` n2) `thenCmp` (_CMP_STRING_ m1 m2)
 				   -- always compare module-names *second*

 rdrNameOcc :: RdrName -> OccName
-rdrNameOcc (Unqual occ) = occ
-rdrNameOcc (Qual _ occ) = occ
+rdrNameOcc (Unqual occ)   = occ
+rdrNameOcc (Qual _ occ _) = occ

 ieOcc :: RdrNameIE -> OccName
 ieOcc ie = rdrNameOcc (ieName ie)
@@ -219,8 +223,8 @@ instance Ord3 RdrName where
    cmp = cmpRdr

 instance Outputable RdrName where
-    ppr sty (Unqual n) = pprQuote sty $ \ sty -> pprOccName sty n
-    ppr sty (Qual m n) = pprQuote sty $ \ sty -> hcat [pprModule sty m, char '.', pprOccName sty n]
+    ppr sty (Unqual n)   = pprQuote sty $ \ sty -> pprOccName sty n
+    ppr sty (Qual m n _) = pprQuote sty $ \ sty -> hcat [pprModule sty m, char '.', pprOccName sty n]

 instance NamedThing RdrName where		-- Just so that pretty-printing of expressions works
    getOccName = rdrNameOcc

--- a/ghc/compiler/reader/ReadPrefix.lhs
+++ b/ghc/compiler/reader/ReadPrefix.lhs
@@ -24,7 +24,7 @@ import HsSyn
 import HsTypes		( HsTyVar(..) )
 import HsPragmas	( noDataPragmas, noClassPragmas, noInstancePragmas, noGenPragmas )
 import RdrHsSyn         
-import BasicTypes	( Fixity(..), FixityDirection(..), NewOrData(..) )
+import BasicTypes	( Fixity(..), FixityDirection(..), NewOrData(..), IfaceFlavour(..) )
 import PrefixToHs

 import CmdLineOpts      ( opt_PprUserLength )
@@ -78,7 +78,7 @@ wlkQid	:: (FAST_STRING -> OccName) -> U_qid -> UgnM RdrName
 wlkQid mk_occ_name (U_noqual name)
  = returnUgn (Unqual (mk_occ_name name))
 wlkQid mk_occ_name (U_aqual  mod name)
-  = returnUgn (Qual mod (mk_occ_name name))
+  = returnUgn (Qual mod (mk_occ_name name) HiFile)

 	-- I don't understand this one!  It is what shows up when we meet (), [], or (,,,).
 wlkQid mk_occ_name (U_gid n name)
@@ -905,7 +905,7 @@ rdImport pt
    mkSrcLocUgn srcline				$ \ src_loc      ->
    wlkMaybe rdU_stringId ias		`thenUgn` \ maybe_as	->
    wlkMaybe rd_spec ispec		`thenUgn` \ maybe_spec	->
-    returnUgn (ImportDecl imod (cvFlag iqual) (cvFlag isrc) maybe_as maybe_spec src_loc)
+    returnUgn (ImportDecl imod (cvFlag iqual) (cvIfaceFlavour isrc) maybe_as maybe_spec src_loc)
  where
    rd_spec pt = rdU_either pt 		`thenUgn` \ spec ->
      case spec of
@@ -913,6 +913,9 @@ rdImport pt
 		      returnUgn (False, ents)
 	U_right pt -> rdEntities pt 	`thenUgn` \ ents ->
 		      returnUgn (True, ents)
+
+cvIfaceFlavour 0 = HiFile	-- No pragam
+cvIfaceFlavour 1 = HiBootFile	-- {-# SOURCE #-}
 \end{code}

 \begin{code}

--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -6,18 +6,18 @@ IMP_Ubiq(){-uitous-}

 import HsSyn		-- quite a bit of stuff
 import RdrHsSyn		-- oodles of synonyms
-import HsDecls		( HsIdInfo(..) )
+import HsDecls		( HsIdInfo(..), HsStrictnessInfo )
 import HsTypes		( mkHsForAllTy )
 import HsCore
 import Literal
-import BasicTypes	( Fixity(..), FixityDirection(..), NewOrData(..), Version(..) )
+import BasicTypes	( IfaceFlavour(..), Fixity(..), FixityDirection(..), NewOrData(..), Version(..) )
 import HsPragmas	( noDataPragmas, noClassPragmas )
 import Kind		( Kind, mkArrowKind, mkBoxedTypeKind )
 import IdInfo           ( ArgUsageInfo, FBTypeInfo )
 import Lex		

 import RnMonad		( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
-			  SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
+			  SYN_IE(RdrNamePragma), SYN_IE(ExportItem), SYN_IE(RdrAvailInfo), GenAvailInfo(..)
 			) 
 import Bag		( emptyBag, unitBag, snocBag )
 import FiniteMap	( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
@@ -149,8 +149,8 @@ module_stuff_pairs  :  						{ [] }
 		    |  module_stuff_pair module_stuff_pairs	{ $1 : $2 }

 module_stuff_pair   ::  { ImportVersion OccName }
-module_stuff_pair   :  mod_name INTEGER DCOLON name_version_pairs SEMI
-			{ ($1, fromInteger $2, $4) }
+module_stuff_pair   :  mod_name opt_bang INTEGER DCOLON name_version_pairs SEMI
+			{ ($1, $2, fromInteger $3, $5) }

 versions_part	    :: { [LocalVersion OccName] }
 versions_part	    :  VERSIONS_PART name_version_pairs		{ $2 }
@@ -171,23 +171,27 @@ exports_part	:  EXPORTS_PART export_items			{ $2 }

 export_items	:: { [ExportItem] }
 export_items	:  			    			{ [] }
-		|  mod_name entities SEMI export_items 		{ ($1,$2) : $4 }
+		|  opt_bang mod_name entities SEMI export_items { ($2,$1,$3) : $5 }

-entities	:: { [(OccName, [OccName])] }
+opt_bang	:: { IfaceFlavour }
+opt_bang	:						{ HiFile }
+		| BANG						{ HiBootFile }
+
+entities	:: { [RdrAvailInfo] }
 entities	: 						{ [] }
 		|  entity entities				{ $1 : $2 }

-entity		:: { (OccName, [OccName]) }
-entity		:  entity_occ 					{ ($1, if isTCOcc $1 
-								       then [$1]  {- AvailTC -}
-								       else [])   {- Avail -} }
-		|  entity_occ stuff_inside			{ ($1, ($1 : $2)) {- TyCls exported too -} }
-		|  entity_occ BANG stuff_inside			{ ($1, $3) 	  {- TyCls not exported -} }
+entity		:: { RdrAvailInfo }
+entity		:  entity_occ 				{ if isTCOcc $1 
+							  then AvailTC $1 [$1]
+							  else Avail $1 }
+		|  entity_occ stuff_inside		{ AvailTC $1 ($1:$2) }
+		|  entity_occ VBAR stuff_inside		{ AvailTC $1 $3 }

 stuff_inside	:: { [OccName] }
-stuff_inside	:  OPAREN val_occs1 CPAREN			{ $2
+stuff_inside	:  OPAREN val_occs1 CPAREN		{ $2
 --------------------------------------------------------------------------
-								}
+							}

 inst_modules_part :: { [Module] }
 inst_modules_part :				    		{ [] }
@@ -259,7 +263,9 @@ csigs1		: csig				{ [$1] }
 		| csig SEMI csigs1		{ $1 : $3 }

 csig		:: { RdrNameSig }
-csig		:  var_name DCOLON type 	{ ClassOpSig $1 $1 $3 mkIfaceSrcLoc
+csig		:  var_name DCOLON type 	{ ClassOpSig $1 Nothing $3 mkIfaceSrcLoc }
+	        |  var_name EQUAL DCOLON type	{ ClassOpSig $1 (Just (error "Un-filled-in default method"))
+								$4 mkIfaceSrcLoc
 ----------------------------------------------------------------
 			 			 }

@@ -371,8 +377,8 @@ val_occs1	:: { [OccName] }


 qvar_name	:: { RdrName }
-		:  QVARID		{ varQual $1 }
-		|  QVARSYM		{ varQual $1 }
+		:  QVARID		{ lexVarQual $1 }
+		|  QVARSYM		{ lexVarQual $1 }

 var_name	:: { RdrName }
 var_name	:  var_occ		{ Unqual $1 }
@@ -386,8 +392,8 @@ any_var_name	:  var_name		{ $1 }
 		|  qvar_name		{ $1 }

 qdata_name	:: { RdrName }
-qdata_name	:  QCONID		{ varQual $1 }
-		|  QCONSYM		{ varQual $1 }
+qdata_name	:  QCONID		{ lexVarQual $1 }
+		|  QCONSYM		{ lexVarQual $1 }

 data_name	:: { RdrName }
 data_name	:  CONID		{ Unqual (VarOcc $1) }
@@ -400,10 +406,11 @@ tc_names1	:: { [RdrName] }

 tc_name		:: { RdrName }
 tc_name		: tc_occ			{ Unqual $1 }
-		| QCONID			{ tcQual $1 }
+		| QCONID			{ lexTcQual $1 }

 tv_name		:: { RdrName }
 tv_name		:  VARID 		{ Unqual (TvOcc $1) }
+		|  VARSYM		{ Unqual (TvOcc $1) {- Allow $t2 as a tyvar -} }

 tv_names	:: { [RdrName] }
 		:  			{ [] }

--- a/ghc/compiler/rename/ParseType.y
+++ b/ghc/compiler/rename/ParseType.y
@@ -6,7 +6,7 @@ IMP_Ubiq(){-uitous-}

 import HsSyn		-- quite a bit of stuff
 import RdrHsSyn		-- oodles of synonyms
-import HsDecls		( HsIdInfo(..) )
+import HsDecls		( HsIdInfo(..), HsStrictnessInfo )
 import HsTypes		( mkHsForAllTy )
 import HsCore
 import Literal
@@ -18,7 +18,7 @@ import Kind		( Kind, mkArrowKind, mkBoxedTypeKind )
 import Lex		

 import RnMonad		( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
-			  SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
+			  SYN_IE(RdrNamePragma), SYN_IE(ExportItem), GenAvailInfo
 			) 
 import Bag		( emptyBag, unitBag, snocBag )
 import FiniteMap	( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
@@ -128,13 +128,14 @@ akind		:: { Kind }

 tv_name		:: { RdrName }
 tv_name		:  VARID 		{ Unqual (TvOcc $1) }
+		|  VARSYM		{ Unqual (TvOcc $1) {- Allow $t2 as a tyvar -} }

 tv_names	:: { [RdrName] }
 		:  			{ [] }
 		| tv_name tv_names	{ $1 : $2 }

 tc_name		:: { RdrName }
-tc_name		:  QCONID		{ tcQual $1 }
+tc_name		:  QCONID		{ lexTcQual $1 }
 		|  CONID		{ Unqual (TCOcc $1) }
 		|  CONSYM		{ Unqual (TCOcc $1) }
 		|  OPAREN RARROW CPAREN	{ Unqual (TCOcc SLIT("->")) }

--- a/ghc/compiler/rename/ParseUnfolding.y
+++ b/ghc/compiler/rename/ParseUnfolding.y
@@ -6,7 +6,7 @@ IMP_Ubiq(){-uitous-}

 import HsSyn		-- quite a bit of stuff
 import RdrHsSyn		-- oodles of synonyms
-import HsDecls		( HsIdInfo(..) )
+import HsDecls		( HsIdInfo(..), HsStrictnessInfo(..) )
 import HsTypes		( mkHsForAllTy )
 import HsCore
 import Literal
@@ -19,7 +19,7 @@ import Kind		( Kind, mkArrowKind, mkBoxedTypeKind )
 import Lex		

 import RnMonad		( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
-			  SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
+			  SYN_IE(RdrNamePragma), SYN_IE(ExportItem), GenAvailInfo
 			) 
 import Bag		( emptyBag, unitBag, snocBag )
 import FiniteMap	( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
@@ -123,16 +123,16 @@ id_info		: 	 					{ [] }
 id_info_item	:: { HsIdInfo RdrName }
 id_info_item	: ARITY_PART arity_info			{ HsArity $2 }
 		| STRICT_PART strict_info		{ HsStrictness $2 }
-		| BOTTOM 				{ HsStrictness mkBottomStrictnessInfo }
+		| BOTTOM 				{ HsStrictness HsBottom }
 		| UNFOLD_PART core_expr			{ HsUnfold $1 $2 }

 arity_info	:: { ArityInfo }
 arity_info	: INTEGER					{ exactArity (fromInteger $1) }

-strict_info	:: { StrictnessInfo RdrName }
-strict_info	: DEMAND any_var_name OCURLY data_names CCURLY 	{ mkStrictnessInfo $1 (Just ($2,$4)) }
-		| DEMAND any_var_name 			 	{ mkStrictnessInfo $1 (Just ($2,[])) }
-		| DEMAND 					{ mkStrictnessInfo $1 Nothing }
+strict_info	:: { HsStrictnessInfo RdrName }
+strict_info	: DEMAND any_var_name OCURLY data_names CCURLY 	{ HsStrictnessInfo $1 (Just ($2,$4)) }
+		| DEMAND any_var_name 			 	{ HsStrictnessInfo $1 (Just ($2,[])) }
+		| DEMAND 					{ HsStrictnessInfo $1 Nothing }

 core_expr	:: { UfExpr RdrName }
 core_expr	: any_var_name					{ UfVar $1 }
@@ -255,14 +255,14 @@ var_occ		: VARID			{ VarOcc $1 }
 		| BANG  		{ VarOcc SLIT("!") {-sigh, double-sigh-} }

 data_name	:: { RdrName }
-data_name	:  QCONID		{ varQual $1 }
-		|  QCONSYM		{ varQual $1 }
+data_name	:  QCONID		{ lexVarQual $1 }
+		|  QCONSYM		{ lexVarQual $1 }
 		|  CONID		{ Unqual (VarOcc $1) }
 		|  CONSYM		{ Unqual (VarOcc $1) }

 qvar_name	:: { RdrName }
-		:  QVARID		{ varQual $1 }
-		|  QVARSYM		{ varQual $1 }
+		:  QVARID		{ lexVarQual $1 }
+		|  QVARSYM		{ lexVarQual $1 }

 var_name	:: { RdrName }
 var_name	:  var_occ		{ Unqual $1 }
@@ -339,13 +339,14 @@ akind		:: { Kind }

 tv_name		:: { RdrName }
 tv_name		:  VARID 		{ Unqual (TvOcc $1) }
+		|  VARSYM		{ Unqual (TvOcc $1) {- Allow $t2 as a tyvar -} }

 tv_names	:: { [RdrName] }
 		:  			{ [] }
 		| tv_name tv_names	{ $1 : $2 }

 tc_name		:: { RdrName }
-tc_name		:  QCONID		{ tcQual $1 }
+tc_name		:  QCONID		{ lexTcQual $1 }
 		|  CONID		{ Unqual (TCOcc $1) }
 		|  CONSYM		{ Unqual (TCOcc $1) }
 		|  OPAREN RARROW CPAREN	{ Unqual (TCOcc SLIT("->")) }
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -220,7 +220,7 @@ closeDecls necessity decls
 	-- An unresolved name
 	Just name
 	  -> 	-- Slurp its declaration, if any
-	     traceRn (sep [ptext SLIT("Considering"), ppr PprDebug name])	`thenRn_`
+--	     traceRn (sep [ptext SLIT("Considering"), ppr PprDebug name])	`thenRn_`
 	     importDecl name necessity		`thenRn` \ maybe_decl ->
 	     case maybe_decl of


--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs