[project @ 1996-06-11 13:18:54 by partain]

SLPJ changes to 960611

ghc/compiler/HsVersions.h

@@ -99,7 +99,7 @@ you will screw up the layout where they are used in case expressions!
 
 #endif  {- ! __GLASGOW_HASKELL__ -}
 
-#if __GLASGOW_HASKELL__ >= 23 && __GLASGOW_HASKELL__ < 200
+#if __GLASGOW_HASKELL__ >= 23
 #define USE_FAST_STRINGS 1
 #define FAST_STRING _PackedString
 #define SLIT(x)	    (_packCString (A# x#))

ghc/compiler/absCSyn/AbsCSyn.lhs

@@ -218,8 +218,6 @@ data CStmtMacro
   | UPD_BH_SINGLE_ENTRY
   | PUSH_STD_UPD_FRAME
   | POP_STD_UPD_FRAME
-  | SET_ARITY
-  | CHK_ARITY
   | SET_TAG
   | GRAN_FETCH	    		-- for GrAnSim only  -- HWL
   | GRAN_RESCHEDULE   		-- for GrAnSim only  -- HWL
@@ -502,34 +500,34 @@ We need magical @Eq@ because @VanillaReg@s come in multiple flavors.
 
 \begin{code}
 instance Eq MagicId where
-    reg1 == reg2 = tagOf_MagicId reg1 _EQ_ tagOf_MagicId reg2
-
-tagOf_MagicId BaseReg		= (ILIT(0) :: FAST_INT)
-tagOf_MagicId StkOReg		= ILIT(1)
-tagOf_MagicId TagReg		= ILIT(2)
-tagOf_MagicId RetReg		= ILIT(3)
-tagOf_MagicId SpA		= ILIT(4)
-tagOf_MagicId SuA		= ILIT(5)
-tagOf_MagicId SpB		= ILIT(6)
-tagOf_MagicId SuB		= ILIT(7)
-tagOf_MagicId Hp		= ILIT(8)
-tagOf_MagicId HpLim		= ILIT(9)
-tagOf_MagicId LivenessReg	= ILIT(10)
-tagOf_MagicId StdUpdRetVecReg	= ILIT(12)
-tagOf_MagicId StkStubReg	= ILIT(13)
-tagOf_MagicId CurCostCentre	= ILIT(14)
-tagOf_MagicId VoidReg		= ILIT(15)
-
-tagOf_MagicId (VanillaReg _ i) = ILIT(15) _ADD_ i
-
-tagOf_MagicId (FloatReg i) = ILIT(15) _ADD_ maxv _ADD_ i
-  where
-    maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
-
-tagOf_MagicId (DoubleReg i) = ILIT(15) _ADD_ maxv _ADD_ maxf _ADD_ i
-  where
-    maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
-    maxf = case mAX_Float_REG   of { IBOX(x) -> x }
+    reg1 == reg2 = tag reg1 _EQ_ tag reg2
+     where
+	tag BaseReg	     = (ILIT(0) :: FAST_INT)
+	tag StkOReg	     = ILIT(1)
+	tag TagReg	     = ILIT(2)
+	tag RetReg	     = ILIT(3)
+	tag SpA		     = ILIT(4)
+	tag SuA		     = ILIT(5)
+	tag SpB		     = ILIT(6)
+	tag SuB		     = ILIT(7)
+	tag Hp		     = ILIT(8)
+	tag HpLim	     = ILIT(9)
+	tag LivenessReg	     = ILIT(10)
+	tag StdUpdRetVecReg  = ILIT(12)
+	tag StkStubReg	     = ILIT(13)
+	tag CurCostCentre    = ILIT(14)
+	tag VoidReg	     = ILIT(15)
+
+	tag (VanillaReg _ i) = ILIT(15) _ADD_ i
+
+	tag (FloatReg i) = ILIT(15) _ADD_ maxv _ADD_ i
+	  where
+	    maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
+
+	tag (DoubleReg i) = ILIT(15) _ADD_ maxv _ADD_ maxf _ADD_ i
+	  where
+	    maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
+	    maxf = case mAX_Float_REG   of { IBOX(x) -> x }
 \end{code}
 
 Returns True for any register that {\em potentially} dies across

ghc/compiler/absCSyn/Costs.lhs

@@ -363,8 +363,6 @@ stmtMacroCosts macro modes =
     UPD_BH_SINGLE_ENTRY	  ->  Cost (3, 0, 0, 1, 0)	 {- SMupdate.lh	 -}
     PUSH_STD_UPD_FRAME	  ->  Cost (3, 0, 0, 4, 0)	 {- SMupdate.lh	 -}
     POP_STD_UPD_FRAME	  ->  Cost (1, 0, 3, 0, 0)	 {- SMupdate.lh	 -}
-    SET_ARITY		  ->  nullCosts		    {- StgMacros.lh  -}
-    CHK_ARITY		  ->  nullCosts		    {- StgMacros.lh  -}
     SET_TAG		  ->  nullCosts		    {- COptRegs.lh -}
     GRAN_FETCH			->  nullCosts	  {- GrAnSim bookkeeping -}
     GRAN_RESCHEDULE		->  nullCosts	  {- GrAnSim bookkeeping -}

ghc/compiler/basicTypes/Id.lhs

@@ -17,7 +17,7 @@ module Id {- (
 	mkSpecId, mkSameSpecCon,
 	selectIdInfoForSpecId,
 	mkTemplateLocals,
-	mkImported, mkPreludeId,
+	mkImported,
 	mkDataCon, mkTupleCon,
 	mkIdWithNewUniq,
 	mkMethodSelId, mkSuperDictSelId, mkDefaultMethodId,
@@ -105,11 +105,11 @@ import CStrings		( identToC, cSEP )
 import IdInfo
 import Maybes		( maybeToBool )
 import Name		( appendRdr, nameUnique, mkLocalName, isLocalName,
-			  isLocallyDefinedName, isPreludeDefinedName,
+			  isLocallyDefinedName,
 			  mkTupleDataConName, mkCompoundName, mkCompoundName2,
-			  isLexSym, isLexSpecialSym, getLocalName,
-			  isLocallyDefined, isPreludeDefined, changeUnique,
-			  getOccName, moduleNamePair, origName, nameOf, 
+			  isLexSym, isLexSpecialSym,
+			  isLocallyDefined, changeUnique,
+			  getOccName, origName, moduleOf,
 			  isExported, ExportFlag(..),
 			  RdrName(..), Name
 			)
@@ -183,8 +183,6 @@ data IdDetails
 
   | ImportedId			-- Global name (Imported or Implicit); Id imported from an interface
 
-  | PreludeId			-- Global name (Builtin);  Builtin prelude Ids
-
   | TopLevId			-- Global name (LocalDef); Top-level in the orig source pgm
 				-- (not moved there by transformations).
 
@@ -237,7 +235,7 @@ data IdDetails
 				-- The "a" is irrelevant.  As it is too painful to
 				-- actually do comparisons that way, we kindly supply
 				-- a Unique for that purpose.
-		(Maybe Module)	-- module where instance came from; Nothing => Prelude
+		Module		-- module where instance came from
 
 				-- see below
   | ConstMethodId		-- A method which depends only on the type of the
@@ -245,7 +243,7 @@ data IdDetails
 		Class		-- Uniquely identified by:
 		Type		-- (class, type, classop) triple
 		ClassOp
-		(Maybe Module)	-- module where instance came from; Nothing => Prelude
+		Module		-- module where instance came from
 
   | InstId			-- An instance of a dictionary, class operation,
 				-- or overloaded value (Local name)
@@ -357,9 +355,6 @@ the infinite family of tuples.
 {\em Everything} we want to know about them must be stored here (or in
 their @IdInfo@).
 
-%----------------------------------------------------------------------
-\item[@PreludeId@:] ToDo
-
 %----------------------------------------------------------------------
 \item[@TopLevId@:] These are values defined at the top-level in this
 module; i.e., those which {\em might} be exported (hence, a
@@ -499,7 +494,6 @@ toplevelishId (Id _ _ _ details _ _)
     chk (TupleConId _)    	    = True
     chk (RecordSelId _)   	    = True
     chk ImportedId	    	    = True
-    chk PreludeId	    	    = True
     chk TopLevId	    	    = True	-- NB: see notes
     chk (SuperDictSelId _ _)	    = True
     chk (MethodSelId _ _)	    = True
@@ -521,7 +515,6 @@ idHasNoFreeTyVars (Id _ _ _ details _ info)
     chk (TupleConId _)    	  = True
     chk (RecordSelId _)   	  = True
     chk ImportedId	    	  = True
-    chk PreludeId	    	  = True
     chk TopLevId	    	  = True
     chk (SuperDictSelId _ _)	  = True
     chk (MethodSelId _ _)	  = True
@@ -608,7 +601,6 @@ pprIdInUnfolding in_scopes v
     	case v_details of
 	    -- these ones must have been exported by their original module
 	  ImportedId   -> pp_full_name
-	  PreludeId    -> pp_full_name
 
 	    -- these ones' exportedness checked later...
 	  TopLevId  -> pp_full_name
@@ -653,7 +645,7 @@ pprIdInUnfolding in_scopes v
 
     pp_full_name
       = let
-	    (m_str, n_str) = moduleNamePair v
+	    (OrigName m_str n_str) = origName "Id:ppr_Unfolding" v
 
 	    pp_n =
 	      if isLexSym n_str && not (isLexSpecialSym n_str) then
@@ -877,7 +869,7 @@ unlocaliseId mod (Id u name ty info (InstId no_ftvs))
 	-- type might be wrong, but it hardly matters
 	-- at this stage (just before printing C)  ToDo
   where
-    name = getLocalName name
+    name = nameOf (origName "Id.unlocaliseId" name)
     full_name = mkFullName mod name InventedInThisModule ExportAll mkGeneratedSrcLoc
 
 unlocaliseId mod other_id = Nothing
@@ -1038,42 +1030,41 @@ getInstIdModule other = panic "Id:getInstIdModule"
 
 \begin{code}
 mkSuperDictSelId u c sc ty info
-  = Id u n ty (SuperDictSelId c sc) NoPragmaInfo info
-  where
-    cname = getName c -- we get other info out of here
-
-    n = mkCompoundName u SLIT("sdsel") [origName cname, origName sc] cname
+  = mk_classy_id (SuperDictSelId c sc) SLIT("sdsel") (Left (origName "mkSuperDictSelId" sc)) u c ty info
 
 mkMethodSelId u rec_c op ty info
-  = Id u n ty (MethodSelId rec_c op) NoPragmaInfo info
-  where
-    cname = getName rec_c -- we get other info out of here
-
-    n = mkCompoundName u SLIT("meth") [origName cname, Unqual (classOpString op)] cname
+  = mk_classy_id (MethodSelId rec_c op) SLIT("meth") (Right (classOpString op)) u rec_c ty info
 
 mkDefaultMethodId u rec_c op gen ty info
-  = Id u n ty (DefaultMethodId rec_c op gen) NoPragmaInfo info
+  = mk_classy_id (DefaultMethodId rec_c op gen) SLIT("defm") (Right (classOpString op)) u rec_c ty info
+
+mk_classy_id details str op_str u rec_c ty info
+  = Id u n ty details NoPragmaInfo info
   where
     cname = getName rec_c -- we get other info out of here
+    cname_orig = origName "mk_classy_id" cname
+    cmod = moduleOf cname_orig
 
-    n = mkCompoundName u SLIT("defm") [origName cname, Unqual (classOpString op)] cname
+    n = mkCompoundName u cmod str [Left cname_orig, op_str] cname
 
 mkDictFunId u c ity full_ty from_here locn mod info
   = Id u n full_ty (DictFunId c ity mod) NoPragmaInfo info
   where
-    n = mkCompoundName2 u SLIT("dfun") [origName c] (getTypeString ity) from_here locn
+    n = mkCompoundName2 u mod SLIT("dfun") (Left (origName "mkDictFunId" c) : map Right (getTypeString ity)) from_here locn
 
 mkConstMethodId	u c op ity full_ty from_here locn mod info
   = Id u n full_ty (ConstMethodId c ity op mod) NoPragmaInfo info
   where
-    n = mkCompoundName2 u SLIT("const") [origName c, Unqual (classOpString op)] (getTypeString ity) from_here locn
+    n = mkCompoundName2 u mod SLIT("const") (Left (origName "mkConstMethodId" c) : Right (classOpString op) : map Right (getTypeString ity)) from_here locn
 
 mkWorkerId u unwrkr ty info
   = Id u n ty (WorkerId unwrkr) NoPragmaInfo info
   where
     unwrkr_name = getName unwrkr
+    unwrkr_orig = trace "mkWorkerId:origName:" $ origName "mkWorkerId" unwrkr_name
+    umod = moduleOf unwrkr_orig
 
-    n = mkCompoundName u SLIT("wrk") [origName unwrkr_name] unwrkr_name
+    n = mkCompoundName u umod SLIT("wrk") [Left unwrkr_orig] unwrkr_name
 
 mkInstId u ty name = Id u (changeUnique name u) ty (InstId (no_free_tvs ty)) NoPragmaInfo noIdInfo
 
@@ -1104,7 +1095,6 @@ getConstMethodId clas op ty
 
 \begin{code}
 mkImported  n ty info = Id (nameUnique n) n ty ImportedId NoPragmaInfo info
-mkPreludeId n ty info = Id (nameUnique n) n ty PreludeId  NoPragmaInfo info
 
 {-LATER:
 updateIdType :: Id -> Type -> Id
@@ -1642,23 +1632,6 @@ instance Outputable {-Id, i.e.:-}(GenId Type) where
 
 showId :: PprStyle -> Id -> String
 showId sty id = ppShow 80 (pprId sty id)
-
--- [used below]
--- for DictFuns (instances) and const methods (instance code bits we
--- can call directly): exported (a) if *either* the class or
--- ***OUTERMOST*** tycon [arbitrary...] is exported; or (b) *both*
--- class and tycon are from PreludeCore [non-std, but convenient]
--- *and* the thing was defined in this module.
-
-instance_export_flag :: Class -> Type -> Bool -> ExportFlag
-
-instance_export_flag clas inst_ty from_here
-  = panic "Id:instance_export_flag"
-{-LATER
-  = if instanceIsExported clas inst_ty from_here
-    then ExportAll
-    else NotExported
--}
 \end{code}
 
 Default printing code (not used for interfaces):
@@ -1677,53 +1650,6 @@ instance Uniquable (GenId ty) where
 
 instance NamedThing (GenId ty) where
     getName this_id@(Id u n _ details _ _) = n
-{- OLD:
-      = get details
-      where
-	get (LocalId      _)  	= n
-	get (SysLocalId   _)  	= n
-	get (SpecPragmaId _ _)	= n
-	get ImportedId		= n
-	get PreludeId		= n
-	get TopLevId		= n
-	get (InstId       n _)  	= n
-	get (DataConId _ _ _ _ _ _ _) = n
-	get (TupleConId _)		= n
-	get (RecordSelId l)		= getName l
-	get _				= mkCompoundName u (getIdNamePieces False{-no Uniques-} this_id)
--}
-{- LATER:
-	get (MethodSelId c op)	= case (moduleOf (origName c)) of -- ToDo; better ???
-				    mod -> (mod, classOpString op)
-
-	get (SpecId unspec ty_maybes _)
-	  = case moduleNamePair unspec	      of { (mod, unspec_nm) ->
-	    case specMaybeTysSuffix ty_maybes of { tys_suffix ->
-	    (mod,
-	     unspec_nm _APPEND_
-		(if not (toplevelishId unspec)
-		 then showUnique u
-		 else tys_suffix)
-	    ) }}
-
-	get (WorkerId unwrkr)
-	  = case moduleNamePair unwrkr	of { (mod, unwrkr_nm) ->
-	    (mod,
-	     unwrkr_nm _APPEND_
-		(if not (toplevelishId unwrkr)
-		 then showUnique u
-		 else SLIT(".wrk"))
-	    ) }
-
-	get other_details
-	    -- the remaining internally-generated flavours of
-	    -- Ids really do not have meaningful "original name" stuff,
-	    -- but we need to make up something (usually for debugging output)
-
-	  = case (getIdNamePieces True this_id)  of { (piece1:pieces) ->
-	    case [ _CONS_ '.' p | p <- pieces ]  of { dotted_pieces ->
-	    (_NIL_, _CONCAT_ (piece1 : dotted_pieces)) }}
--}
 \end{code}
 
 Note: The code generator doesn't carry a @UniqueSupply@, so it uses

ghc/compiler/basicTypes/IdInfo.lhs

@@ -69,7 +69,7 @@ module IdInfo (
 
 IMP_Ubiq()
 
-IMPORT_DELOOPER(IdLoop)		-- IdInfo is a dependency-loop ranch, and
+IMPORT_DELOOPER(IdLoop)	-- IdInfo is a dependency-loop ranch, and
 			-- we break those loops by using IdLoop and
 			-- *not* importing much of anything else,
 			-- except from the very general "utils".
@@ -77,7 +77,6 @@ IMPORT_DELOOPER(IdLoop)		-- IdInfo is a dependency-loop ranch, and
 import CmdLineOpts	( opt_OmitInterfacePragmas )
 import Maybes		( firstJust )
 import MatchEnv		( nullMEnv, isEmptyMEnv, mEnvToList )
-import OccurAnal	( occurAnalyseGlobalExpr )
 import Outputable	( ifPprInterface, Outputable(..){-instances-} )
 import PprStyle		( PprStyle(..) )
 import Pretty

ghc/compiler/basicTypes/IdLoop.lhi

@@ -18,6 +18,7 @@ import Id		( externallyVisibleId, isDataCon, isWorkerId, isWrapperId,
 import IdInfo		( IdInfo )
 import Literal		( Literal )
 import MagicUFs		( mkMagicUnfoldingFun, MagicUnfoldingFun )
+import OccurAnal	( occurAnalyseGlobalExpr )
 import Outputable	( Outputable(..) )
 import PprEnv		( NmbrEnv )
 import PprStyle		( PprStyle )
@@ -31,6 +32,7 @@ import Usage		( GenUsage )
 import Util		( Ord3(..) )
 import WwLib		( mAX_WORKER_ARGS )
 
+occurAnalyseGlobalExpr  :: GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique -> GenCoreExpr (GenId (GenType (GenTyVar (GenUsage Unique)) Unique), BinderInfo) (GenId (GenType (GenTyVar (GenUsage Unique)) Unique)) (GenTyVar (GenUsage Unique)) Unique
 externallyVisibleId	:: Id	    -> Bool
 isDataCon		:: GenId ty -> Bool
 isWorkerId		:: GenId ty -> Bool

ghc/compiler/basicTypes/IdUtils.lhs

@@ -13,10 +13,10 @@ IMPORT_DELOOPER(PrelLoop)		-- here for paranoia checking
 
 import CoreSyn
 import CoreUnfold	( UnfoldingGuidance(..) )
-import Id		( mkPreludeId, mkTemplateLocals )
+import Id		( mkImported, mkTemplateLocals )
 import IdInfo		-- quite a few things
-import Name		( mkBuiltinName )
-import PrelMods		( pRELUDE_BUILTIN )
+import Name		( mkPrimitiveName, OrigName(..) )
+import PrelMods		( gHC_BUILTINS )
 import PrimOp		( primOpInfo, tagOf_PrimOp, primOp_str,
 			  PrimOpInfo(..), PrimOpResultInfo(..) )
 import RnHsSyn		( RnName(..) )
@@ -35,33 +35,33 @@ primOpNameInfo op = (primOp_str  op, WiredInId (primOpId op))
 primOpId op
   = case (primOpInfo op) of
       Dyadic str ty ->
-	mk_prim_Id op pRELUDE_BUILTIN str [] [ty,ty] (dyadic_fun_ty ty) 2
+	mk_prim_Id op str [] [ty,ty] (dyadic_fun_ty ty) 2
 
       Monadic str ty ->
-	mk_prim_Id op pRELUDE_BUILTIN str [] [ty] (monadic_fun_ty ty) 1
+	mk_prim_Id op str [] [ty] (monadic_fun_ty ty) 1
 
       Compare str ty ->
-	mk_prim_Id op pRELUDE_BUILTIN str [] [ty,ty] (compare_fun_ty ty) 2
+	mk_prim_Id op str [] [ty,ty] (compare_fun_ty ty) 2
 
       Coercing str ty1 ty2 ->
-	mk_prim_Id op pRELUDE_BUILTIN str [] [ty1] (mkFunTys [ty1] ty2) 1
+	mk_prim_Id op str [] [ty1] (mkFunTys [ty1] ty2) 1
 
       PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
-	mk_prim_Id op pRELUDE_BUILTIN str
+	mk_prim_Id op str
 	    tyvars
 	    arg_tys
 	    (mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys)))
 	    (length arg_tys) -- arity
 
       AlgResult str tyvars arg_tys tycon res_tys ->
-	mk_prim_Id op pRELUDE_BUILTIN str
+	mk_prim_Id op str
 	    tyvars
 	    arg_tys
 	    (mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys)))
 	    (length arg_tys) -- arity
   where
-    mk_prim_Id prim_op mod name tyvar_tmpls arg_tys ty arity
-      = mkPreludeId (mkBuiltinName key mod name) ty
+    mk_prim_Id prim_op name tyvar_tmpls arg_tys ty arity
+      = mkImported (mkPrimitiveName key (OrigName gHC_BUILTINS name)) ty
 	   (noIdInfo `addInfo` (mkArityInfo arity)
 	          `addInfo_UF` (mkUnfolding EssentialUnfolding
 			         (mk_prim_unfold prim_op tyvar_tmpls arg_tys)))

ghc/compiler/basicTypes/Name.lhs

@@ -9,7 +9,12 @@
 module Name (
 	Module(..),
 
+	OrigName(..), -- glorified pair
+	qualToOrigName, -- a Qual to an OrigName
+
 	RdrName(..),
+	preludeQual,
+	moduleNamePair,
 	isUnqual,
 	isQual,
 	isRdrLexCon, isRdrLexConOrSpecial,
@@ -20,9 +25,10 @@ module Name (
 	Name,
 	Provenance,
 	mkLocalName, isLocalName, 
-	mkTopLevName, mkImportedName,
+	mkTopLevName, mkImportedName, oddlyImportedName,
 	mkImplicitName,	isImplicitName,
-	mkBuiltinName, mkCompoundName, mkCompoundName2,
+	mkPrimitiveName, mkWiredInName,
+	mkCompoundName, mkCompoundName2,
 
 	mkFunTyConName, mkTupleDataConName, mkTupleTyConName,
 	mkTupNameStr,
@@ -33,19 +39,18 @@ module Name (
 
 	nameUnique, changeUnique,
 	nameOccName,
-	nameOrigName,
+--	nameOrigName, : not exported
 	nameExportFlag,
 	nameSrcLoc,
 	nameImpLocs,
 	nameImportFlag,
-	isLocallyDefinedName,
-	isPreludeDefinedName,
+	isLocallyDefinedName, isWiredInName,
 
-	origName, moduleOf, nameOf, moduleNamePair,
+	origName, moduleOf, nameOf,
 	getOccName, getExportFlag,
 	getSrcLoc, getImpLocs,
-	isLocallyDefined, isPreludeDefined,
-	getLocalName, ltLexical,
+	isLocallyDefined,
+	getLocalName,
 
 	isSymLexeme, pprSym, pprNonSym,
 	isLexCon, isLexVar, isLexId, isLexSym, isLexSpecialSym,
@@ -54,10 +59,11 @@ module Name (
 
 IMP_Ubiq()
 
+import CmdLineOpts	( maybe_CompilingPrelude )
 import CStrings		( identToC, cSEP )
 import Outputable	( Outputable(..) )
 import PprStyle		( PprStyle(..), codeStyle )
-import PrelMods		( pRELUDE, pRELUDE_BUILTIN, fromPrelude )
+import PrelMods		( pRELUDE )
 import Pretty
 import SrcLoc		( mkBuiltinSrcLoc, mkUnknownSrcLoc )
 import Unique		( funTyConKey, mkTupleDataConUnique, mkTupleTyConUnique,
@@ -79,10 +85,20 @@ ord = fromEnum :: Char -> Int
 \begin{code}
 type Module = FAST_STRING
 
+data OrigName = OrigName Module FAST_STRING
+
+qualToOrigName (Qual m n) = OrigName m n
+
 data RdrName
   = Unqual FAST_STRING
   | Qual   Module FAST_STRING
 
+preludeQual n = Qual pRELUDE n
+
+moduleNamePair (Qual m n) = (m, n)  -- we make *no* claim whether this
+				    -- constitutes an original name or
+				    -- an occurrence name, or anything else
+
 isUnqual (Unqual _) = True
 isUnqual (Qual _ _) = False
 
@@ -96,13 +112,16 @@ isRdrLexConOrSpecial (Unqual n) = isLexCon n || isLexSpecialSym n
 isRdrLexConOrSpecial (Qual m n) = isLexCon n || isLexSpecialSym n
 
 appendRdr (Unqual n) str = Unqual (n _APPEND_ str)
-appendRdr (Qual m n) str = ASSERT(not (fromPrelude m))
-			   Qual m (n _APPEND_ str)
+appendRdr (Qual m n) str = Qual m (n _APPEND_ str)
 
-cmpRdr (Unqual n1)  (Unqual n2)  = _CMP_STRING_ n1 n2
-cmpRdr (Unqual n1)  (Qual m2 n2) = LT_
-cmpRdr (Qual m1 n1) (Unqual n2)  = GT_
-cmpRdr (Qual m1 n1) (Qual m2 n2) = _CMP_STRING_ m1 m2 `thenCmp` _CMP_STRING_ n1 n2
+cmpRdr (Unqual  n1) (Unqual  n2) = _CMP_STRING_ n1 n2
+cmpRdr (Unqual  n1) (Qual m2 n2) = LT_
+cmpRdr (Qual m1 n1) (Unqual  n2) = GT_
+cmpRdr (Qual m1 n1) (Qual m2 n2) = _CMP_STRING_ n1 n2 `thenCmp` _CMP_STRING_ m1 m2
+				   -- always compare module-names *second*
+
+cmpOrig (OrigName m1 n1) (OrigName m2 n2)
+  = _CMP_STRING_ n1 n2 `thenCmp` _CMP_STRING_ m1 m2 -- again; module-names *second*
 
 instance Eq RdrName where
     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
@@ -119,8 +138,14 @@ instance Ord3 RdrName where
 
 instance NamedThing RdrName where
     -- We're sorta faking it here
-    getName rdr_name
-      = Global u rdr_name prov ex [rdr_name]
+    getName (Unqual n)
+      = Local u n True locn
+      where
+	u    = panic "NamedThing.RdrName:Unique1"
+	locn = panic "NamedThing.RdrName:locn"
+
+    getName rdr_name@(Qual m n)
+      = Global u m n prov ex [rdr_name]
       where
 	u    = panic "NamedThing.RdrName:Unique"
 	prov = panic "NamedThing.RdrName:Provenance"
@@ -139,6 +164,26 @@ pp_name sty n | codeStyle sty = identToC n
               | otherwise     = ppPStr n	      
 
 showRdr sty rdr = ppShow 100 (ppr sty rdr)
+
+-------------------------
+instance Eq OrigName where
+    a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
+    a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
+
+instance Ord OrigName where
+    a <= b = case (a `cmp` b) of { LT_ -> True;	 EQ_ -> True;  GT__ -> False }
+    a <	 b = case (a `cmp` b) of { LT_ -> True;	 EQ_ -> False; GT__ -> False }
+    a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
+    a >	 b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
+
+instance Ord3 OrigName where
+    cmp = cmpOrig
+
+instance NamedThing OrigName where -- faking it
+    getName (OrigName m n) = getName (Qual m n)
+
+instance Outputable OrigName where -- ditto
+    ppr sty (OrigName m n) = ppr sty (Qual m n)
 \end{code}
 
 %************************************************************************
@@ -156,7 +201,8 @@ data Name
              SrcLoc
 
   | Global   Unique
-             RdrName	-- original name; Unqual => prelude
+             Module	-- original name
+	     FAST_STRING
              Provenance -- where it came from
              ExportFlag -- is it exported?
              [RdrName]  -- ordered occurrence names (usually just one);
@@ -170,57 +216,71 @@ data Provenance
              [SrcLoc]   -- any import source location(s)
 
   | Implicit
-  | Builtin
+  | Primitive		-- really and truly primitive thing (not
+			-- definable in Haskell)
+  | WiredIn  Bool	-- something defined in Haskell; True <=>
+			-- definition is in the module in question;
+			-- this probably comes from the -fcompiling-prelude=...
+			-- flag.
 \end{code}
 
 \begin{code}
 mkLocalName = Local
 
-mkTopLevName   u orig locn exp occs = Global u orig (LocalDef locn) exp occs
-mkImportedName u orig imp locn imp_locs exp occs = Global u orig (Imported imp locn imp_locs) exp occs
+mkTopLevName   u (OrigName m n) locn exp occs = Global u m n (LocalDef locn) exp occs
+mkImportedName u (OrigName m n) imp locn imp_locs exp occs = Global u m n (Imported imp locn imp_locs) exp occs
 
-mkImplicitName :: Unique -> RdrName -> Name
-mkImplicitName u o = Global u o Implicit NotExported []
+mkImplicitName :: Unique -> OrigName -> Name
+mkImplicitName u (OrigName m n) = Global u m n Implicit NotExported []
 
-mkBuiltinName :: Unique -> Module -> FAST_STRING -> Name
-mkBuiltinName u m n
-  = Global u (if fromPrelude m then Unqual n else Qual m n) Builtin NotExported []
+mkPrimitiveName :: Unique -> OrigName -> Name
+mkPrimitiveName u (OrigName m n)  = Global u m n Primitive NotExported []
+
+mkWiredInName :: Unique -> OrigName -> Name
+mkWiredInName u (OrigName m n)
+  = Global u m n (WiredIn from_here) (if from_here then ExportAll else NotExported) []
+  where
+    from_here
+      = case maybe_CompilingPrelude of
+          Nothing  -> False
+	  Just mod -> mod == _UNPK_ m
 
 mkCompoundName :: Unique
+	       -> Module
 	       -> FAST_STRING	-- indicates what kind of compound thing it is (e.g., "sdsel")
-	       -> [RdrName]	-- "dot" these names together
+	       -> [Either OrigName FAST_STRING]	-- "dot" these names together
 	       -> Name		-- from which we get provenance, etc....
 	       -> Name		-- result!
 
-mkCompoundName u str ns (Local _ _ _ _) = panic "mkCompoundName:Local?"
-mkCompoundName u str ns (Global _ _ prov exp _)
-  = Global u (Unqual{-???-} (_CONCAT_ (glue ns [str]))) prov exp []
+mkCompoundName u m str ns (Local _ _ _ _) = panic "mkCompoundName:Local?"
+mkCompoundName u m str ns (Global _ _ _ prov exp _)
+  = Global u m (_CONCAT_ (glue ns [str])) prov exp []
 
-glue []            acc = reverse acc
-glue (Unqual n:ns) acc = glue ns (_CONS_ '.' n : acc)
-glue (Qual m n:ns) acc = glue ns (_CONS_ '.' n : _CONS_ '.' m : acc)
+glue []                       acc = reverse acc
+glue (Left (OrigName m n):ns) acc = glue ns (_CONS_ '.' n : _CONS_ '.' m : acc)
+glue (Right n            :ns) acc = glue ns (_CONS_ '.' n : acc)