[project @ 2000-11-14 08:07:11 by simonpj]

Changing the way we know whether
something is exported.

THIS COMMIT WON'T EVEN COMPILE
(I'm doing it to transfer from my laptop.)
Wait till later today before updating.

ghc/compiler/basicTypes/DataCon.lhs

@@ -36,7 +36,7 @@ import Type		( Type, TauType, ClassContext,
 import TyCon		( TyCon, tyConDataCons, tyConDataConsIfAvailable, isDataTyCon, isProductTyCon,
 			  isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
 import Class		( Class, classTyCon )
-import Name		( Name, NamedThing(..), nameUnique, isLocallyDefined )
+import Name		( Name, NamedThing(..), nameUnique )
 import Var		( TyVar, Id )
 import FieldLabel	( FieldLabel )
 import BasicTypes	( Arity )
@@ -454,9 +454,8 @@ unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type
 unbox_strict_arg_ty tycon strict_mark ty
   | case strict_mark of
 	NotMarkedStrict   -> False
-	MarkedUnboxed _ _ -> True
-	MarkedStrict      -> opt_UnboxStrictFields &&
-			     isLocallyDefined tycon &&
+	MarkedUnboxed _ _ -> True				-- !! From interface file
+	MarkedStrict      -> opt_UnboxStrictFields &&		-- !  From source
 			     maybeToBool maybe_product &&
 			     not (isRecursiveTyCon tycon) &&
 			     isDataTyCon arg_tycon

ghc/compiler/basicTypes/Id.lhs

@@ -32,7 +32,7 @@ module Id (
 	isDataConId, isDataConId_maybe, isDataConWrapId, 
 		isDataConWrapId_maybe,
 	isBottomingId,
-	isExportedId, isUserExportedId,
+	isExportedId, isLocalId, 
 	hasNoBinding,
 
 	-- Inline pragma stuff
@@ -91,7 +91,7 @@ import IdInfo
 import Demand		( Demand )
 import Name	 	( Name, OccName,
 			  mkSysLocalName, mkLocalName,
-			  isUserExportedName, nameIsLocallyDefined,
+			  nameIsLocallyDefined,
 			  getOccName, isIPOcc
 			) 
 import OccName		( UserFS )
@@ -132,10 +132,10 @@ Absolutely all Ids are made by mkId.  It
 
 \begin{code}
 mkId :: Name -> Type -> IdInfo -> Id
-mkId name ty info = mkIdVar name (addFreeTyVars ty) info'
-		  where
-		    info' | isUserExportedName name = setNoDiscardInfo info
-			  | otherwise		    = info
+mkId name ty info = mkIdVar name (addFreeTyVars ty) info
+
+mkImportedId :: Name -> Type -> IdInfo -> Id
+mkImportedId name ty info = mkId name ty (info `setFlavourInfo` ImportedId)
 \end{code}
 
 \begin{code}
@@ -255,18 +255,21 @@ hasNoBinding id = case idFlavour id of
 
 -- Don't drop a binding for an exported Id,
 -- if it otherwise looks dead.  
+-- Perhaps a better name would be isDiscardableId
 isExportedId :: Id -> Bool
-isExportedId id = isUserExportedId id	-- Try this
-{-
-  case idFlavour id of
-			VanillaId -> False
-			other	  -> True	-- All the others are no-discard
--}
-
--- Say if an Id was exported by the user
--- Implies isExportedId (see mkId above)
-isUserExportedId :: Id -> Bool
-isUserExportedId id = isUserExportedName (idName id)
+isExportedId id = case idFlavour id of
+			VanillaId  -> False
+			other	   -> True
+
+isLocalId :: Id -> Bool
+-- True of Ids that are locally defined, but are not constants
+-- like data constructors, record selectors, and the like. 
+-- See comments with CoreSyn.isLocalVar
+isLocalId id = case idFlavour id of
+		 VanillaId    -> True
+		 ExportedId   -> True
+		 SpecPragmaId -> True
+		 other	      -> False
 \end{code}
 
 
@@ -302,7 +305,7 @@ omitIfaceSigForId' id
 -- these names are bound by either a class declaration or a data declaration
 -- or an explicit user export.
 exportWithOrigOccName :: Id -> Bool
-exportWithOrigOccName id = omitIfaceSigForId id || isUserExportedId id
+exportWithOrigOccName id = omitIfaceSigForId id || isExportedId id
 \end{code}
 
 \begin{code}

ghc/compiler/basicTypes/IdInfo.lhs

@@ -17,7 +17,7 @@ module IdInfo (
 
 	-- Flavour
 	IdFlavour(..), flavourInfo, 
-	setNoDiscardInfo,
+	setNoDiscardInfo, setFlavourInfo,
 	ppFlavourInfo,
 
 	-- Arity
@@ -164,6 +164,7 @@ megaSeqIdInfo info
 Setters
 
 \begin{code}
+setFlavourInfo    info fl = fl `seq` info { flavourInfo = wk }
 setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
 setSpecInfo 	  info sp = PSEQ sp (info { specInfo = sp })
 setTyGenInfo      info tg = tg `seq` info { tyGenInfo = tg }
@@ -236,7 +237,12 @@ mkIdInfo flv = IdInfo {
 
 \begin{code}
 data IdFlavour
-  = VanillaId 			-- Most Ids are like this
+  = VanillaId			-- Locally defined, not exported
+  | ExportedId			-- Locally defined, exported
+  | SpecPragmaId		-- Locally defined, RHS holds specialised call
+
+  | ImportedId 			-- Imported from elsewhere
+
   | DataConId DataCon		-- The Id for a data constructor *worker*
   | DataConWrapId DataCon	-- The Id for a data constructor *wrapper*
 				-- [the only reasons we need to know is so that
@@ -245,17 +251,17 @@ data IdFlavour
 				--     Id back to the data con]
   | PrimOpId PrimOp		-- The Id for a primitive operator
   | RecordSelId FieldLabel	-- The Id for a record selector
-  | SpecPragmaId		-- Don't discard these
-  | NoDiscardId			-- Don't discard these either
+
 
 ppFlavourInfo :: IdFlavour -> SDoc
 ppFlavourInfo VanillaId         = empty
+ppFlavourInfo ExportedId        = ptext SLIT("[Exported]")
+ppFlavourInfo SpecPragmaId    	= ptext SLIT("[SpecPrag]")
+ppFlavourInfo ImportedId        = ptext SLIT("[Imported]")
 ppFlavourInfo (DataConId _)     = ptext SLIT("[DataCon]")
 ppFlavourInfo (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
 ppFlavourInfo (PrimOpId _)    	= ptext SLIT("[PrimOp]")
 ppFlavourInfo (RecordSelId _) 	= ptext SLIT("[RecSel]")
-ppFlavourInfo SpecPragmaId    	= ptext SLIT("[SpecPrag]")
-ppFlavourInfo NoDiscardId     	= ptext SLIT("[NoDiscard]")
 
 seqFlavour :: IdFlavour -> ()
 seqFlavour f = f `seq` ()

ghc/compiler/basicTypes/Name.lhs

@@ -10,17 +10,16 @@ module Name (
 
 	-- The Name type
 	Name,					-- Abstract
-	mkLocalName, mkImportedLocalName, mkSysLocalName, mkCCallName,
+	mkLocalName, mkSysLocalName, mkCCallName,
 	mkTopName, mkIPName,
 	mkDerivedName, mkGlobalName, mkKnownKeyGlobal, mkWiredInName,
 
-	nameUnique, setNameUnique, setLocalNameSort,
+	nameUnique, setNameUnique,
 	tidyTopName, 
 	nameOccName, nameModule, nameModule_maybe,
 	setNameOcc, nameRdrName, setNameModuleAndLoc, 
 	toRdrName, hashName,
 
-	isUserExportedName,
 	nameSrcLoc, nameIsLocallyDefined, isDllName, nameIsFrom, nameIsLocalOrFrom,
 
 	isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
@@ -36,7 +35,7 @@ module Name (
 
 	-- Class NamedThing and overloaded friends
 	NamedThing(..),
-	getSrcLoc, isLocallyDefined, getOccString, toRdrName,
+	getSrcLoc, getOccString, toRdrName,
 	isFrom, isLocalOrFrom
     ) where
 
@@ -70,11 +69,11 @@ data Name = Name {
 
 data NameSort
   = Global Module	-- (a) TyCon, Class, their derived Ids, dfun Id
-			-- (b) imported Id
+			-- (b) Imported Id
+			-- (c) Top-level Id in the original source, even if
+			--	locally defined
 
-  | Exported		-- An exported Ids defined in the module being compiled
-
-  | Local		-- A user-defined, but non-exported Id or TyVar,
+  | Local		-- A user-defined Id or TyVar
 			-- defined in the module being compiled
 
   | System		-- A system-defined Id or TyVar.  Typically the
@@ -83,17 +82,18 @@ data NameSort
 
 Notes about the NameSorts:
 
-1.  An Exported Id is changed to Global right at the
-    end in the tidyCore pass, so that an importer sees a Global
-    Similarly, Local Ids that are visible to an importer (e.g. when 
-    optimisation is on) are changed to Globals.
+1.  Initially, top-level Ids (including locally-defined ones) get Global names, 
+    and all other local Ids get Local names
 
 2.  Things with a @Global@ name are given C static labels, so they finally
     appear in the .o file's symbol table.  They appear in the symbol table
     in the form M.n.  If originally-local things have this property they
     must be made @Global@ first.
 
-3.  A System Name differs in the following ways:
+3.  In the tidy-core phase, a Global that is not visible to an importer
+    is changed to Local, and a Local that is visible is changed to Global
+
+4.  A System Name differs in the following ways:
 	a) has unique attached when printing dumps
 	b) unifier eliminates sys tyvars in favour of user provs where possible
 
@@ -124,7 +124,6 @@ nameModule_maybe name				= Nothing
 nameIsLocallyDefined	:: Name -> Bool
 nameIsFrom		:: Module -> Name -> Bool
 nameIsLocalOrFrom	:: Module -> Name -> Bool
-isUserExportedName	:: Name -> Bool
 isLocalName		:: Name -> Bool		-- Not globals
 isGlobalName		:: Name -> Bool
 isSystemName		:: Name -> Bool
@@ -145,15 +144,9 @@ nameIsFrom from other			     = pprPanic "nameIsFrom" (ppr other)
 
 -- Global names are by definition those that are visible
 -- outside the module, *as seen by the linker*.  Externally visible
--- does not mean visible at the source level (that's isUserExported).
+-- does not mean visible at the source level
 isExternallyVisibleName name = isGlobalName name
 
--- Constructors, selectors and suchlike Globals, and are all exported
--- Other Local things may or may not be exported
-isUserExportedName (Name { n_sort = Exported }) = True
-isUserExportedName (Name { n_sort = Global _ }) = True
-isUserExportedName other		        = False
-
 isSystemName (Name {n_sort = System}) = True
 isSystemName other		      = False
 \end{code}
@@ -177,18 +170,6 @@ mkLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ, n_
 	--	* for interface files we tidyCore first, which puts the uniques
 	--	  into the print name (see setNameVisibility below)
 
-mkImportedLocalName :: Unique -> OccName -> SrcLoc -> Name
-	-- Just the same as mkLocalName, except the provenance is different
-	-- Reason: this flags the name as one that came in from an interface 
-	-- file. This is useful when trying to decide which of two type
-	-- variables should 'win' when unifying them.
-	-- NB: this is only for non-top-level names, so we use ImplicitImport
-	--
-	-- Oct 00: now that Names lack Provenances, mkImportedLocalName doesn't make
-	--	   sense any more, so it's just the same as mkLocalName
-mkImportedLocalName uniq occ loc = mkLocalName uniq occ loc
-
-
 mkGlobalName :: Unique -> Module -> OccName -> SrcLoc -> Name
 mkGlobalName uniq mod occ loc = Name { n_uniq = uniq, n_sort = Global mod,
 				       n_occ = occ, n_loc = loc }
@@ -244,11 +225,6 @@ setNameModuleAndLoc :: Name -> Module -> SrcLoc -> Name
 setNameModuleAndLoc name mod loc = name {n_sort = set (n_sort name), n_loc = loc}
 		       where
 			 set (Global _) = Global mod
-
-setLocalNameSort :: Name -> Bool -> Name
-  -- Set the name's sort to Local or Exported, depending on the boolean
-setLocalNameSort name is_exported = name { n_sort = if is_exported then Exported
-								   else Local }
 \end{code}
 
 
@@ -293,23 +269,18 @@ are exported.  But also:
     top-level defns externally visible
 
 \begin{code}
-tidyTopName :: Module -> TidyOccEnv -> Name -> (TidyOccEnv, Name)
-tidyTopName mod env
+tidyTopName :: Module -> TidyOccEnv -> Bool -> Name -> (TidyOccEnv, Name)
+tidyTopName mod env is_exported
 	    name@(Name { n_occ = occ, n_sort = sort, n_uniq = uniq, n_loc = loc })
   = case sort of
-	System   -> localise		-- System local Ids
-	Local    -> localise		-- User non-exported Ids
-	Exported -> globalise		-- User-exported things
-	Global _ -> no_op		-- Constructors, class selectors, default methods
+	Global _ | is_exported -> (env, name)
+		 | otherwise   -> (env, name { n_sort = new_sort })
 
+	other    | is_exported -> (env', name { n_sort = Global mod, n_occ = occ' })
+		 | otherwise   -> (env', name { n_sort = new_sort,   n_occ = occ' })
   where
-    no_op     = (env, name)
-
-    globalise = (env, name { n_sort = Global mod })	-- Don't change occurrence name
-
-    localise     = (env', name')
     (env', occ') = tidyOccName env occ
-    name'        = name { n_occ = occ', n_sort = mkLocalTopSort mod }
+    new_sort     = mkLocalTopSort mod
 
 mkTopName :: Unique -> Module -> FAST_STRING -> Name
 	-- Make a top-level name; make it Global if top-level
@@ -359,7 +330,7 @@ nameRdrName (Name { n_occ = occ })			= mkRdrUnqual occ
 isDllName :: Name -> Bool
 	-- Does this name refer to something in a different DLL?
 isDllName nm = not opt_Static &&
-	       not (nameIsLocallyDefined nm) &&			-- isLocallyDefinedName test needed 'cos
+	       not (isLocalName nm) &&				-- isLocalName test needed 'cos
 	       not (isModuleInThisPackage (nameModule nm))	-- nameModule won't work on local names
 
 
@@ -460,13 +431,12 @@ pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
     case sort of
       Global mod -> pprGlobal sty name uniq mod occ
       System     -> pprSysLocal sty uniq occ
-      Local      -> pprLocal sty uniq occ empty
-      Exported   -> pprLocal sty uniq occ (char 'x')
+      Local      -> pprLocal sty uniq occ
 
-pprLocal sty uniq occ pp_export
+pprLocal sty uniq occ
   | codeStyle sty  = pprUnique uniq
   | debugStyle sty = pprOccName occ <> 
-		     text "{-" <> pp_export <+> pprUnique10 uniq <> text "-}"
+		     text "{-" <> pprUnique10 uniq <> text "-}"
   | otherwise      = pprOccName occ
 
 pprGlobal sty name uniq mod occ
@@ -500,20 +470,15 @@ class NamedThing a where
 
 \begin{code}
 getSrcLoc	    :: NamedThing a => a -> SrcLoc
-isLocallyDefined    :: NamedThing a => a -> Bool
 getOccString	    :: NamedThing a => a -> String
 toRdrName	    :: NamedThing a => a -> RdrName
 isFrom		    :: NamedThing a => Module -> a -> Bool
 isLocalOrFrom	    :: NamedThing a => Module -> a -> Bool
 
 getSrcLoc	    = nameSrcLoc	   . getName
-isLocallyDefined    = nameIsLocallyDefined . getName
 getOccString 	    = occNameString	   . getOccName
 toRdrName	    = nameRdrName	   . getName
 isFrom mod x	    = nameIsFrom mod (getName x)
 isLocalOrFrom mod x = nameIsLocalOrFrom mod ( getName x)
 \end{code}
 
-\begin{code}
-{-# SPECIALIZE isLocallyDefined :: Name -> Bool #-}
-\end{code}

ghc/compiler/codeGen/CgBindery.lhs

@@ -44,7 +44,7 @@ import VarEnv
 import VarSet		( varSetElems )
 import Literal		( Literal )
 import Maybes		( catMaybes, maybeToBool )
-import Name		( isLocallyDefined, NamedThing(..) )
+import Name		( isLocalName, NamedThing(..) )
 #ifdef DEBUG
 import PprAbsC		( pprAmode )
 #endif
@@ -251,7 +251,7 @@ I {\em think} all looking-up is done through @getCAddrMode(s)@.
 getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
 
 getCAddrModeAndInfo id
-  | not (isLocallyDefined name) || isDataConWrapId id
+  | not (isLocalName name) || isDataConWrapId id
 	-- Why the isDataConWrapId?  Because CoreToStg changes a call to 
 	-- a nullary constructor worker fn to a call to its wrapper,
 	-- which may not  be defined until later

ghc/compiler/coreSyn/CoreFVs.lhs

@@ -21,26 +21,11 @@ import CoreSyn
 import Id		( Id, idFreeTyVars, hasNoBinding, idSpecialisation )
 import VarSet
 import Var		( Var, isId )
-import Name		( isLocallyDefined )
 import Type		( tyVarsOfType )
 import Util		( mapAndUnzip )
 import Outputable
 \end{code}
 
-%************************************************************************
-%*									*
-\section{Utilities}
-%*									*
-%************************************************************************
-
-\begin{code}
-mustHaveLocalBinding :: Var -> Bool
--- True <=> the variable must have a binding in this module
-mustHaveLocalBinding v
-  | isId v    = isLocallyDefined v && not (hasNoBinding v)
-  | otherwise = True	-- TyVars etc must
-\end{code}
-
 
 %************************************************************************
 %*									*
@@ -58,7 +43,7 @@ but not those that are free in the type of variable occurrence.
 
 \begin{code}
 exprFreeVars :: CoreExpr -> VarSet	-- Find all locally-defined free Ids or tyvars
-exprFreeVars = exprSomeFreeVars isLocallyDefined
+exprFreeVars = exprSomeFreeVars isLocalVar
 
 exprsFreeVars :: [CoreExpr] -> VarSet
 exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
@@ -166,7 +151,7 @@ rulesSomeFreeVars interesting (Rules rules _)
 ruleRhsFreeVars :: CoreRule -> VarSet
 ruleRhsFreeVars (BuiltinRule _) = noFVs
 ruleRhsFreeVars (Rule str tpl_vars tpl_args rhs)
-  = rule_fvs isLocallyDefined emptyVarSet
+  = rule_fvs isLocalVar emptyVarSet
   where
     rule_fvs = addBndrs tpl_vars (expr_fvs rhs)
 
@@ -259,8 +244,8 @@ freeVars (Var v)
 	--	Actually [June 98] I don't think it's necessary
 	-- fvs = fvs_v `unionVarSet` idSpecVars v
 
-    fvs | isLocallyDefined v = aFreeVar v
-	| otherwise	     = noFVs
+    fvs | isLocalVar v = aFreeVar v
+	| otherwise    = noFVs
 
 freeVars (Lit lit) = (noFVs, AnnLit lit)
 freeVars (Lam b body)

ghc/compiler/coreSyn/CoreSyn.lhs

@@ -15,7 +15,8 @@ module CoreSyn (
 	mkConApp, 
 	varToCoreExpr,
 
-	bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, isTyVar, isId,
+	isTyVar, isId, isLocalVar, mustHaveLocalBinding,
+	bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, 
 	collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
 	collectArgs, collectBindersIgnoringNotes,
 	coreExprCc,
@@ -106,6 +107,29 @@ data Note
 \end{code}
 
 
+%************************************************************************
+%*									*
+\subsection{isLocalVar}
+%*									*
+%************************************************************************
+
+@isLocalVar@ returns True of all TyVars, and of Ids that are defined in 
+this module and are not constants like data constructors and record selectors.
+These are the variables that we need to pay attention to when finding free
+variables, or doing dependency analysis.
+
+\begin{code}
+isLocalVar :: Var -> Bool
+isLocalVar v = isTyVar v || isLocalId v
+\end{code}
+
+\begin{code}
+mustHaveLocalBinding :: Var -> Bool
+-- True <=> the variable must have a binding in this module
+mustHaveLocalBinding v = isTyVar v || (isLocalId v && not (hasNoBinding v))
+\end{code}
+
+
 %************************************************************************
 %*									*
 \subsection{Transformation rules}

ghc/compiler/coreSyn/CoreTidy.lhs

@@ -216,7 +216,7 @@ tidyTopId :: Module -> TidyEnv -> TidyEnv -> Id -> (TidyEnv, Id)
 tidyTopId mod env@(tidy_env, var_env) env_idinfo id
   =	-- Top level variables
     let
-	(tidy_env', name') = tidyTopName mod tidy_env (idName id)
+	(tidy_env', name') = tidyTopName mod tidy_env (idIsExported id) (idName id)
 	ty'	           = tidyTopType (idType id)
 	idinfo'		   = tidyIdInfo env_idinfo (idInfo id)
 	id'		   = mkId name' ty' idinfo'

ghc/compiler/deSugar/DsBinds.lhs

@@ -26,7 +26,7 @@ import Match		( matchWrapper )
 
 import CmdLineOpts	( opt_AutoSccsOnAllToplevs, opt_AutoSccsOnExportedToplevs )
 import CostCentre	( mkAutoCC, IsCafCC(..) )
-import Id		( idType, idName, isUserExportedId, isSpecPragmaId, Id )
+import Id		( idType, idName, isExportedId, isSpecPragmaId, Id )
 import NameSet
 import VarSet
 import Type		( mkTyVarTy )
@@ -188,7 +188,7 @@ addSccs NoSccs   exports = NoSccs
 addSccs TopLevel exports 
   = TopLevelAddSccs (\id -> case [ exp | (_,exp,loc) <- exports, loc == id ] of
 				(exp:_)  | opt_AutoSccsOnAllToplevs || 
-					    (isUserExportedId exp && 
+					    (isExportedId exp && 
 					     opt_AutoSccsOnExportedToplevs)
 					-> Just exp
 				_ -> Nothing)

ghc/compiler/hsSyn/HsCore.lhs

@@ -153,7 +153,8 @@ toUfApp (App f a) as = toUfApp f (a:as)
 toUfApp (Var v) as
   = case isDataConId_maybe v of
 	-- We convert the *worker* for tuples into UfTuples
-	Just dc | isTupleTyCon tc && saturated -> UfTuple (HsTupCon (getName dc) (tupleTyConBoxity tc)) tup_args
+	Just dc |  isTupleTyCon tc && saturated 
+		-> UfTuple (HsTupCon (getName dc) (tupleTyConBoxity tc)) tup_args
 	  where
 	    val_args  = dropWhile isTypeArg as
 	    saturated = length val_args == idArity v

ghc/compiler/hsSyn/HsTypes.lhs

@@ -33,7 +33,7 @@ import Type		( Type, Kind, PredType(..), ClassContext,
 import TypeRep		( Type(..), TyNote(..) )	-- toHsType sees the representation
 import TyCon		( isTupleTyCon, tupleTyConBoxity, tyConArity, getSynTyConDefn )
 import RdrName		( RdrName, mkUnqual )
-import Name		( Name, getName, setLocalNameSort )
+import Name		( Name, getName )
 import OccName		( NameSpace, tvName )
 import Var		( TyVar, tyVarKind )
 import Subst		( mkTyVarSubst, substTy )
@@ -88,10 +88,8 @@ hsUsOnce = HsTyVar (mkUnqual tvName SLIT("."))  -- deep magic
 hsUsMany = HsTyVar (mkUnqual tvName SLIT("!"))  -- deep magic
 
 hsUsOnce_Name, hsUsMany_Name :: HsType Name
--- Fudge the TyConName so that it prints unqualified
--- I hate it! I hate it!
-hsUsOnce_Name = HsTyVar (setLocalNameSort usOnceTyConName False)
-hsUsMany_Name = HsTyVar (setLocalNameSort usManyTyConName False)
+hsUsOnce_Name = HsTyVar usOnceTyConName
+hsUsMany_Name = HsTyVar usManyTyConName
 
 -----------------------
 data HsTupCon name = HsTupCon name Boxity

ghc/compiler/main/DriverPipeline.hs

 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.21 2000/11/13 17:12:37 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.22 2000/11/14 08:07:12 simonpj Exp $
 --
 -- GHC Driver
 --
@@ -685,8 +685,9 @@ doLink o_files = do
 #ifdef mingw32_TARGET_OS
     let extra_os = if static || no_hs_main
                    then []
-                   else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
-                          head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
+--                   else [ head (lib_paths (head rts_pkg)) ++ "/Main.dll_o",
+--                          head (lib_paths (head std_pkg)) ++ "/PrelMain.dll_o" ]
+		     else []
 #endif
     (md_c_flags, _) <- machdepCCOpts
     run_something "Linker"

ghc/compiler/main/HscMain.lhs

@@ -175,7 +175,7 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
       	     <- renameModule dflags hit hst pcs_ch this_mod rdr_module
       	; case maybe_rn_result of {
       	     Nothing -> return (HscFail pcs_rn);
-      	     Just (print_unqualified, new_iface, rn_hs_decls) -> do {
+      	     Just (print_unqualified, is_exported, new_iface, rn_hs_decls) -> do {
     
  	    -------------------
  	    -- TYPECHECK
@@ -196,7 +196,7 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
  	    -------------------
       	  -- We grab the the unfoldings at this point.
 	; simpl_result <- dsThenSimplThenTidy dflags (pcs_rules pcs_tc) this_mod 
- 					      print_unqualified tc_result hst
+ 					      print_unqualified is_exported tc_result hst
 	; let (tidy_binds, orphan_rules, foreign_stuff) = simpl_result
       	    
  	    -------------------
@@ -315,7 +315,7 @@ restOfCodeGeneration dflags toInterp this_mod imported_module_names cost_centre_
                        (ppr nm)
 
 
-dsThenSimplThenTidy dflags rule_base this_mod print_unqual tc_result hst
+dsThenSimplThenTidy dflags rule_base this_mod print_unqual is_exported tc_result hst
  = do --------------------------  Desugaring ----------------
       -- _scc_     "DeSugar"
       (desugared, rules, h_code, c_code, fe_binders) 
@@ -324,7 +324,7 @@ dsThenSimplThenTidy dflags rule_base this_mod print_unqual tc_result hst
       --------------------------  Main Core-language transformations ----------------
       -- _scc_     "Core2Core"
       (simplified, orphan_rules) 
-         <- core2core dflags rule_base hst desugared rules
+         <- core2core dflags rule_base hst is_exported desugared rules
 
       -- Do the final tidy-up
       (tidy_binds, tidy_orphan_rules) 

ghc/compiler/main/HscTypes.lhs

@@ -24,7 +24,7 @@ module HscTypes (
 
 	WhetherHasOrphans, ImportVersion, WhatsImported(..),
 	PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
-	IfaceInsts, IfaceRules, GatedDecl,
+	IfaceInsts, IfaceRules, GatedDecl, IsExported,
 	OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
 	AvailEnv, AvailInfo, GenAvailInfo(..),
 	PersistentCompilerState(..),
@@ -45,8 +45,7 @@ module HscTypes (
 #include "HsVersions.h"
 
 import RdrName		( RdrNameEnv, emptyRdrEnv, rdrEnvToList )
-import Name		( Name, NamedThing, isLocallyDefined, 
-			  getName, nameModule, nameSrcLoc )
+import Name		( Name, NamedThing, getName, nameModule, nameSrcLoc )
 import Name -- Env
 import OccName		( OccName )
 import Module		( Module, ModuleName, ModuleEnv,
@@ -222,19 +221,16 @@ emptyIfaceTable = emptyModuleEnv
 Simple lookups in the symbol table.
 
 \begin{code}
-lookupIface :: HomeIfaceTable -> PackageIfaceTable
-	    -> Module -> Name		-- The module is to use for locally-defined names
-	    -> Maybe ModIface
+lookupIface :: HomeIfaceTable -> PackageIfaceTable -> Name -> Maybe ModIface
 -- We often have two IfaceTables, and want to do a lookup
-lookupIface hit pit this_mod name
-  | isLocallyDefined name = lookupModuleEnv hit this_mod
-  | otherwise		  = lookupModuleEnv hit mod `seqMaybe` lookupModuleEnv pit mod
+lookupIface hit pit name
+  = lookupModuleEnv hit mod `seqMaybe` lookupModuleEnv pit mod
   where
     mod = nameModule name
 
-lookupIfaceByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a
--- We often have two Symbol- or IfaceTables, and want to do a lookup
-lookupIfaceByModName ht pt mod
+lookupIfaceByModName :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface
+-- We often have two IfaceTables, and want to do a lookup
+lookupIfaceByModName hit pit mod
   = lookupModuleEnvByName ht mod `seqMaybe` lookupModuleEnvByName pt mod
 \end{code}
 
@@ -285,8 +281,7 @@ extendTypeEnvList env things
 \begin{code}
 lookupType :: HomeSymbolTable -> PackageTypeEnv -> Name -> Maybe TyThing
 lookupType hst pte name
-  = ASSERT2( not (isLocallyDefined name), ppr name )
-    case lookupModuleEnv hst (nameModule name) of
+  = case lookupModuleEnv hst (nameModule name) of
 	Just details -> lookupNameEnv (md_types details) name
 	Nothing	     -> lookupNameEnv pte name
 \end{code}
@@ -403,6 +398,8 @@ data WhatsImported name  = NothingAtAll				-- The module is below us in the
 	--	we imported the module without saying exactly what we imported
 	-- We need to recompile if the module exports changes, because we might
 	-- now have a name clash in the importing module.
+
+type IsExported = Name -> Bool		-- True for names that are exported from this module
 \end{code}
 
 

ghc/compiler/main/MkIface.lhs

@@ -28,7 +28,7 @@ import HscTypes		( VersionInfo(..), ModIface(..), ModDetails(..),
 			)
 
 import CmdLineOpts
-import Id		( Id, idType, idInfo, omitIfaceSigForId, isUserExportedId, hasNoBinding,
+import Id		( Id, idType, idInfo, omitIfaceSigForId, isExportedId, hasNoBinding,
 			  idSpecialisation, idName, setIdInfo
 			)
 import Var		( isId )
@@ -37,13 +37,11 @@ import DataCon		( StrictnessMark(..), dataConSig, dataConFieldLabels, dataConStr
 import IdInfo		-- Lots