[project @ 1999-12-20 10:34:27 by simonpj]

This commit implements a substantial re-organisation of the Prelude
It also fixes a couple of small renamer bugs that were reported recently
	(notably, Sven pointed out that we weren't reporting
	unused imports properly)

My original goal was to get rid of all "orphan" modules (i.e. ones
with instance decls that don't belong either to a tycon or a class
defined in the same module).  This should reduce the number of
interface files that have to be read when compiling small Haskell
modules.

But like most expeditions into the Prelude Swamp, it spiraled out
of control.  The result is quite satisfactory, though.

	GONE AWAY:	PrelCCall, PrelNumExtra

	NEW:		PrelReal, PrelFloat, PrelByteArr, PrelNum.hi-boot

(The extra PrelNum.hi-boot is because of a tiresome thin-air Id, addr2Integer,
which used to be in PrelBase.)

Quite a lot of types have moved from one module to another,
which entails some changes to part of the compiler (PrelInfo, PrelMods) etc,
and there are a few places in the RTS includes and even in the driver
that know about these home modules (alas).

So the rough structure is as follows, in (linearised) dependency order
	[this list now appears in PrelBase.lhs]

PrelGHC		Has no implementation.  It defines built-in things, and
		by importing it you bring them into scope.
		The source file is PrelGHC.hi-boot, which is just
		copied to make PrelGHC.hi

		Classes: CCallable, CReturnable

PrelBase	Classes: Eq, Ord, Functor, Monad
		Types:   list, (), Int, Bool, Ordering, Char, String

PrelTup		Types: tuples, plus instances for PrelBase classes

PrelShow	Class: Show, plus instances for PrelBase/PrelTup types

PrelEnum	Class: Enum,  plus instances for PrelBase/PrelTup types

PrelMaybe	Type: Maybe, plus instances for PrelBase classes

PrelNum		Class: Num, plus instances for Int
		Type:  Integer, plus instances for all classes so far (Eq, Ord, Num, Show)

		Integer is needed here because it is mentioned in the signature
		of 'fromInteger' in class Num

PrelReal	Classes: Real, Integral, Fractional, RealFrac
			 plus instances for Int, Integer
		Types:  Ratio, Rational
			plus intances for classes so far

		Rational is needed here because it is mentioned in the signature
		of 'toRational' in class Real

Ix		Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples

PrelArr		Types: Array, MutableArray, MutableVar

		Does *not* contain any ByteArray stuff (see PrelByteArr)
		Arrays are used by a function in PrelFloat

PrelFloat	Classes: Floating, RealFloat
		Types:   Float, Double, plus instances of all classes so far

		This module contains everything to do with floating point.
		It is a big module (900 lines)
		With a bit of luck, many modules can be compiled without ever reading PrelFloat.hi

PrelByteArr	Types: ByteArray, MutableByteArray

		We want this one to be after PrelFloat, because it defines arrays
		of unboxed floats.


Other Prelude modules are much easier with fewer complex dependencies.

4 files changed, 88 insertions, 57 deletions

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index e1381ba88d..f95b222031 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -25,14 +25,14 @@ import RnIfaces		( getImportedInstDecls, importDecl, getImportVersions,
 			  getImportedRules, loadHomeInterface, getSlurped, removeContext
 			)
 import RnEnv		( availName, availNames, availsToNameSet, 
-			  warnUnusedTopNames, mapFvRn, lookupImplicitOccRn,
+			  warnUnusedImports, warnUnusedLocalBinds, mapFvRn, lookupImplicitOccRn,
 			  FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs
 			)
 import Module           ( Module, ModuleName, pprModule, mkSearchPath, mkThisModule )
 import Name		( Name, isLocallyDefined,
 			  NamedThing(..), ImportReason(..), Provenance(..),
-			  pprOccName, nameOccName,
-			  getNameProvenance, 
+			  pprOccName, nameOccName, nameUnique,
+			  getNameProvenance, isUserImportedExplicitlyName,
 			  maybeWiredInTyConName, maybeWiredInIdName, isWiredInName
 			)
 import Id		( idType )
@@ -42,7 +42,7 @@ import RdrName		( RdrName )
 import NameSet
 import PrelMods		( mAIN_Name, pREL_MAIN_Name )
 import TysWiredIn	( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
-import PrelInfo		( ioTyCon_NAME, numClass_RDR, thinAirIdNames, derivingOccurrences )
+import PrelInfo		( ioTyCon_NAME, thinAirIdNames, fractionalClassKeys, derivingOccurrences )
 import Type		( namesOfType, funTyCon )
 import ErrUtils		( printErrorsAndWarnings, dumpIfSet, ghcExit )
 import BasicTypes	( NewOrData(..) )
@@ -52,6 +52,7 @@ import UniqSupply	( UniqSupply )
 import UniqFM		( lookupUFM )
 import Util		( equivClasses )
 import Maybes		( maybeToBool )
+import SrcLoc		( mkBuiltinSrcLoc )
 import Outputable
 \end{code}
 
@@ -118,7 +119,7 @@ rename this_mod@(HsModule mod_name vers _ imports local_decls loc)
     in
     slurpImpDecls real_source_fvs	`thenRn` \ rn_imp_decls ->
     let
-	rn_all_decls	   = rn_imp_decls ++ rn_local_decls 
+	rn_all_decls	   = rn_local_decls ++ rn_imp_decls
     in
 
 	-- EXIT IF ERRORS FOUND
@@ -164,21 +165,20 @@ mentioned explicitly, but which might be needed by the type checker.
 \begin{code}
 implicitFVs mod_name decls
   = mapRn lookupImplicitOccRn implicit_occs	`thenRn` \ implicit_names ->
-    returnRn (implicit_main		`plusFV` 
-	      mkNameSet default_tys	`plusFV`
-	      mkNameSet thinAirIdNames	`plusFV`
+    returnRn (implicit_main				`plusFV` 
+	      mkNameSet (map getName default_tycons)	`plusFV`
+	      mkNameSet thinAirIdNames			`plusFV`
 	      mkNameSet implicit_names)
-    
   where
-	-- Add occurrences for Int, Double, and (), because they
+ 	-- Add occurrences for Int, and (), because they
 	-- are the types to which ambigious type variables may be defaulted by
 	-- the type checker; so they won't always appear explicitly.
 	-- [The () one is a GHC extension for defaulting CCall results.]
 	-- ALSO: funTyCon, since it occurs implicitly everywhere!
 	--  	 (we don't want to be bothered with making funTyCon a
 	--	  free var at every function application!)
-    default_tys = [getName intTyCon, getName doubleTyCon,
-		   getName unitTyCon, getName funTyCon, getName boolTyCon]
+	-- Double is dealt with separately in getGates
+    default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
 
 	-- Add occurrences for IO or PrimIO
     implicit_main |  mod_name == mAIN_Name
@@ -190,7 +190,6 @@ implicitFVs mod_name decls
 	-- generate code
     implicit_occs = foldr ((++) . get) [] decls
 
-    get (DefD _) = [numClass_RDR]
     get (TyClD (TyData _ _ _ _ _ (Just deriv_classes) _ _))
        = concat (map get_deriv deriv_classes)
     get other = []
@@ -229,6 +228,17 @@ isOrphanDecl other = False
 \end{code}
 
 
+\begin{code}
+dupDefaultDeclErrRn (DefaultDecl _ locn1 : dup_things)
+  = pushSrcLocRn locn1	$
+    addErrRn msg
+  where
+    msg = hang (ptext SLIT("Multiple default declarations"))
+	       4  (vcat (map pp dup_things))
+    pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
+\end{code}
+
+
 %*********************************************************
 %*						 	 *
 \subsection{Slurping declarations}
@@ -285,7 +295,7 @@ slurpSourceRefs source_binders source_fvs
 	  rnInstDecls decls1 fvs1 gates1 inst_decls		`thenRn` \ (decls2, fvs2, gates2) ->
 	  go_outer decls2 fvs2 (all_gates `plusFV` gates2)
 			       (nameSetToList (gates2 `minusNameSet` all_gates))
-		-- Knock out the all_gates because even ifwe don't slurp any new
+		-- Knock out the all_gates because even if we don't slurp any new
 		-- decls we can get some apparently-new gates from wired-in names
 
     go_inner decls fvs gates []
@@ -408,14 +418,25 @@ getGates source_fvs (SigD (IfaceSig _ ty _ _))
   = extractHsTyNames ty
 
 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ _ _))
-  = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
+  = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
 		       (map getTyVarName tvs)
-    `addOneToNameSet` cls
+     `addOneToNameSet` cls)
+    `plusFV` maybe_double
   where
     get (ClassOpSig n _ _ ty _) 
 	| n `elemNameSet` source_fvs = extractHsTyNames ty
 	| otherwise		     = emptyFVs
 
+	-- If we load any numeric class that doesn't have
+	-- Int as an instance, add Double to the gates. 
+	-- This takes account of the fact that Double might be needed for
+	-- defaulting, but we don't want to load Double (and all its baggage)
+	-- if the more exotic classes aren't used at all.
+    maybe_double | nameUnique cls `elem` fractionalClassKeys 
+		 = unitFV (getName doubleTyCon)
+		 | otherwise
+		 = emptyFVs
+
 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
   = delListFromNameSet (extractHsTyNames ty)
 		       (map getTyVarName tvs)
@@ -510,20 +531,11 @@ reportUnusedNames gbl_env avail_env (ExportEnv export_avails _ _) mentioned_name
 	   nameSetToList (defined_names `minusNameSet` really_used_names)
 
 	-- Filter out the ones only defined implicitly
-	bad_guys = filter reportableUnusedName defined_but_not_used
+	bad_locals = [n | n <- defined_but_not_used, isLocallyDefined		  n]
+	bad_imps   = [n | n <- defined_but_not_used, isUserImportedExplicitlyName n]
     in
-    warnUnusedTopNames bad_guys
-
-reportableUnusedName :: Name -> Bool
-reportableUnusedName name
-  = explicitlyImported (getNameProvenance name)
-  where
-    explicitlyImported (LocalDef _ _) 		             = True
-	-- Report unused defns of local vars
-    explicitlyImported (NonLocalDef (UserImport _ _ expl) _) = expl
- 	-- Report unused explicit imports
-    explicitlyImported other			             = False
-	-- Don't report others
+    warnUnusedLocalBinds bad_locals	`thenRn_`
+    warnUnusedImports bad_imps
 
 rnDump  :: [RenamedHsDecl] 	-- Renamed imported decls
 	-> [RenamedHsDecl] 	-- Renamed local decls
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index a4fad13d9c..62312174be 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -631,7 +631,10 @@ filterAvail (IEVar v)      avail@(AvailTC n ns) = Just (AvailTC n (filter wanted
 	-- 	import A( op ) 
 	-- where op is a class operation
 
-filterAvail (IEThingAll _) avail@(AvailTC _ _)  = Just avail
+filterAvail (IEThingAll _) avail@(AvailTC _ _)   = Just avail
+	-- We don't complain even if the IE says T(..), but
+	-- no constrs/class ops of T are available
+	-- Instead that's caught with a warning by the caller
 
 filterAvail ie avail = Nothing
 
@@ -694,18 +697,19 @@ mapFvRn f xs = mapRn f xs	`thenRn` \ stuff ->
 %************************************************************************
 
 
+
 \begin{code}
-warnUnusedLocalBinds, warnUnusedTopNames, warnUnusedMatches :: [Name] -> RnM d ()
+warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
 
-warnUnusedTopNames names
-  | not opt_WarnUnusedBinds && not opt_WarnUnusedImports
-  = returnRn () 	-- Don't force ns unless necessary
+warnUnusedImports names
+  | not opt_WarnUnusedImports
+  = returnRn () 	-- Don't force names unless necessary
   | otherwise
-  = warnUnusedBinds (\ is_local -> not is_local) names
+  = warnUnusedBinds (const True) names
 
 warnUnusedLocalBinds ns
   | not opt_WarnUnusedBinds = returnRn ()
-  | otherwise		    = warnUnusedBinds (\ is_local -> is_local) ns
+  | otherwise		    = warnUnusedBinds (const True) ns
 
 warnUnusedMatches names
   | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
@@ -731,6 +735,12 @@ warnUnusedBinds warn_when_local names
 
 -------------------------
 
+--	NOTE: the function passed to warnUnusedGroup is
+--	now always (const True) so we should be able to
+--	simplify the code slightly.  I'm leaving it there
+--	for now just in case I havn't realised why it was there.
+--	Looks highly bogus to me.  SLPJ Dec 99
+
 warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
 warnUnusedGroup emit_warning names
   | null filtered_names         = returnRn ()
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index ceb91aa3d1..a46eb5b33a 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -58,7 +58,7 @@ import NameSet
 import Var		( Id )
 import SrcLoc		( mkSrcLoc, SrcLoc )
 import PrelMods		( pREL_GHC )
-import PrelInfo		( cCallishTyKeys, thinAirModules )
+import PrelInfo		( cCallishTyKeys )
 import Bag
 import Maybes		( MaybeErr(..), maybeToBool, orElse )
 import ListSetOps	( unionLists )
@@ -973,12 +973,18 @@ readIface the_mod file_path
 				context = [],
 				glasgow_exts = 1#,
 				loc = mkSrcLoc (mkFastString file_path) 1 } of
-	          PFailed err                    -> failWithRn Nothing err 
 		  POk _  (PIface mod_nm iface) ->
 		    warnCheckRn (mod_nm == moduleName the_mod)
 		    	        (hiModuleNameMismatchWarn the_mod mod_nm) `thenRn_`
 		    returnRn (Just (the_mod, iface))
 
+	          PFailed err   -> failWithRn Nothing err 
+	          other 	-> failWithRn Nothing (ptext SLIT("Unrecognisable interface file"))
+			 	-- This last case can happen if the interface file is (say) empty
+				-- in which case the parser thinks it looks like an IdInfo or
+				-- something like that.  Just an artefact of the fact that the
+				-- parser is used for several purposes at once.
+
         Left err
 	  | isDoesNotExistError err -> returnRn Nothing
 	  | otherwise               -> failWithRn Nothing (cannaeReadFile file_path err)
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index d98dc2aca9..176eca3b3e 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -413,10 +413,9 @@ filterImports mod (Just (want_hiding, import_items)) avails
       = addErrRn (badImportItemErr mod item)	`thenRn_`
 	returnRn Nothing
 
-      | dodgy_import = addWarnRn (dodgyImportWarn mod item)	`thenRn_`
-		       returnRn (Just (filtered_avail, explicits))
-
-      | otherwise    = returnRn (Just (filtered_avail, explicits))
+      | otherwise    
+      = warnCheckRn (okItem item avail) (dodgyImportWarn mod item)	`thenRn_`
+        returnRn (Just (filtered_avail, explicits))
 		
       where
  	wanted_occ	       = rdrNameOcc (ieName item)
@@ -432,13 +431,12 @@ filterImports mod (Just (want_hiding, import_items)) avails
 		    IEThingAll _    -> True
 		    other	    -> False
 
-	dodgy_import = case (item, avail) of
-			  (IEThingAll _, AvailTC _ [n]) -> True
-				-- This occurs when you import T(..), but
-				-- only export T abstractly.  The single [n]
-				-- in the AvailTC is the type or class itself
-					
-			  other -> False
+
+okItem (IEThingAll _) (AvailTC _ [n]) = False
+		-- This occurs when you import T(..), but
+		-- only export T abstractly.  The single [n]
+		-- in the AvailTC is the type or class itself
+okItem _ _ = True
 \end{code}
 
 
@@ -608,7 +606,10 @@ exportsFromAvail this_mod (Just export_items)
 	= failWithRn acc (exportItemErr ie)
 
 	| otherwise	-- Phew!  It's OK!  Now to check the occurrence stuff!
-	= check_occs ie occs export_avail	`thenRn` \ occs' ->
+
+
+	= warnCheckRn (okItem ie avail) (dodgyExportWarn ie)	`thenRn_`
+          check_occs ie occs export_avail			`thenRn` \ occs' ->
 	  returnRn (mods, occs', add_avail avails export_avail)
 
        where
@@ -659,17 +660,20 @@ badImportItemErr mod ie
   = sep [ptext SLIT("Module"), quotes (pprModuleName mod), 
 	 ptext SLIT("does not export"), quotes (ppr ie)]
 
-dodgyImportWarn mod (IEThingAll tc)
-  = sep [ptext SLIT("Module") <+> quotes (pprModuleName mod)
-			      <+> ptext SLIT("exports") <+> quotes (ppr tc), 
-	 ptext SLIT("with no constructors/class operations;"),
-	 ptext SLIT("yet it is imported with a (..)")]
+dodgyImportWarn mod item = dodgyMsg (ptext SLIT("import")) item
+dodgyExportWarn     item = dodgyMsg (ptext SLIT("export")) item
 
+dodgyMsg kind item@(IEThingAll tc)
+  = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr item),
+	  ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
+	  ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]
+	  
 modExportErr mod
   = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModuleName mod)]
 
 exportItemErr export_item
-  = sep [ ptext SLIT("Bad export item"), quotes (ppr export_item)]
+  = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
+	  ptext SLIT("attempts to export constructors or class methods that are not visible here") ]
 
 exportClashErr occ_name ie1 ie2
   = hsep [ptext SLIT("The export items"), quotes (ppr ie1)
@@ -703,5 +707,4 @@ dupFixityDecl rdr_name loc1 loc2
   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 	  ptext SLIT("at ") <+> ppr loc1,
 	  ptext SLIT("and") <+> ppr loc2]
-
 \end{code}