[project @ 1998-12-18 17:40:31 by simonpj]

Another big commit from Simon.  Actually, the last one
didn't all go into the main trunk; because of a CVS glitch it
ended up in the wrong branch.

So this commit includes:

* Scoped type variables
* Warnings for unused variables should work now (they didn't before)
* Simplifier improvements:
	- Much better treatment of strict arguments
	- Better treatment of bottoming Ids
	- No need for w/w split for fns that are merely strict
	- Fewer iterations needed, I hope
* Less gratuitous renaming in interface files and abs C
* OccName is a separate module, and is an abstract data type

I think the whole Prelude and Exts libraries compile correctly.
Something isn't quite right about typechecking existentials though.

15 files changed, 61 insertions, 71 deletions

diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs
index f204197bb2..ff4d4c8c1a 100644
--- a/ghc/compiler/codeGen/CgBindery.lhs
+++ b/ghc/compiler/codeGen/CgBindery.lhs
@@ -53,7 +53,7 @@ import PrimRep          ( PrimRep(..) )
 import StgSyn		( StgArg, StgLiveVars, GenStgArg(..) )
 import Unique           ( Unique, Uniquable(..) )
 import UniqSet		( elementOfUniqSet )
-import Util		( zipWithEqual, panic, sortLt )
+import Util		( zipWithEqual, sortLt )
 import Outputable
 \end{code}
 
diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index f4da725a15..474059d93b 100644
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.18 1998/12/02 13:17:46 simonm Exp $
+% $Id: CgCase.lhs,v 1.19 1998/12/18 17:40:48 simonpj Exp $
 %
 %********************************************************
 %*							*
@@ -61,7 +61,7 @@ import PrimRep		( getPrimRepSize, retPrimRepSize, PrimRep(..)
 import TyCon		( TyCon, isEnumerationTyCon, isUnboxedTupleTyCon,
 			  isNewTyCon, isAlgTyCon,
 			  tyConDataCons, tyConFamilySize )
-import Type		( GenType(..), typePrimRep, splitAlgTyConApp, Type,
+import Type		( Type, typePrimRep, splitAlgTyConApp, splitAlgTyConApp_maybe,
 			  splitFunTys, applyTys )
 import Unique           ( Unique, Uniquable(..) )
 import Maybes		( maybeToBool )
@@ -1018,16 +1018,13 @@ getScrutineeTyCon ty =
 			_ -> Just tc
 
 splitAlgTyConAppThroughNewTypes  :: Type -> Maybe (TyCon, [Type])
-splitAlgTyConAppThroughNewTypes (TyConApp tc tys) 
-	| isNewTyCon tc = 
-		case (tyConDataCons tc) of
-			[con] -> let ([ty], _) = splitFunTys 
-					      (applyTys (dataConType con) tys)
-				 in  splitAlgTyConAppThroughNewTypes ty
-			_ -> Nothing
-	| otherwise = Just (tc, tys)
-
-splitAlgTyConAppThroughNewTypes (NoteTy _ ty)    = 
-	splitAlgTyConAppThroughNewTypes ty
-splitAlgTyConAppThroughNewTypes other	     = Nothing
+splitAlgTyConAppThroughNewTypes ty
+  = case splitAlgTyConApp_maybe ty of
+	Just (tc, tys, cons)
+	  | isNewTyCon tc ->  splitAlgTyConAppThroughNewTypes ty
+	  | otherwise     ->  Just (tc, tys)
+	  where
+	    ([ty], _) = splitFunTys (applyTys (dataConType (head cons)) tys)
+
+	other  -> Nothing
 \end{code}
diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index 37ee5b3211..1cf5d2bd48 100644
--- a/ghc/compiler/codeGen/CgClosure.lhs
+++ b/ghc/compiler/codeGen/CgClosure.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgClosure.lhs,v 1.20 1998/12/02 13:17:47 simonm Exp $
+% $Id: CgClosure.lhs,v 1.21 1998/12/18 17:40:49 simonpj Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -47,10 +47,10 @@ import ClosureInfo	-- lots and lots of stuff
 import CmdLineOpts	( opt_GranMacros, opt_SccProfilingOn )
 import CostCentre	
 import Id		( Id, idName, idType, idPrimRep )
-import Name		( Name )
+import Name		( Name, Module, pprModule )
 import ListSetOps	( minusList )
 import PrimRep		( PrimRep(..) )
-import Type             ( showTypeCategory )
+import PprType          ( showTypeCategory )
 import Util		( isIn )
 import CmdLineOpts	( opt_SccProfilingOn )
 import Outputable
@@ -663,7 +663,7 @@ Otherwise it is determind by @closureDescription@ from the let
 binding information.
 
 \begin{code}
-closureDescription :: FAST_STRING	-- Module
+closureDescription :: Module		-- Module
 		   -> Name		-- Id of closure binding
 		   -> String
 
@@ -673,7 +673,7 @@ closureDescription :: FAST_STRING	-- Module
 closureDescription mod_name name
   = showSDoc (
 	hcat [char '<',
-		   ptext mod_name,
+		   pprModule mod_name,
 		   char '.',
 		   ppr name,
 		   char '>'])
diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index 3a0d539cb2..1d71cd03f4 100644
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -50,6 +50,7 @@ import PrelInfo		( maybeCharLikeCon, maybeIntLikeCon )
 import PrimRep		( PrimRep(..) )
 import BasicTypes	( TopLevelFlag(..) )
 import Util
+import Panic		( assertPanic )
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index 7ec3f0a345..01a7003173 100644
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ b/ghc/compiler/codeGen/CgExpr.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgExpr.lhs,v 1.16 1998/12/03 17:23:30 simonm Exp $
+% $Id: CgExpr.lhs,v 1.17 1998/12/18 17:40:50 simonpj Exp $
 %
 %********************************************************
 %*							*
@@ -18,7 +18,6 @@ import Constants	( mAX_SPEC_SELECTEE_SIZE, mAX_SPEC_AP_SIZE )
 import StgSyn
 import CgMonad
 import AbsCSyn
-import AbsCUtils	( mkAbstractCs )
 import CLabel		( mkClosureTblLabel )
 
 import SMRep		( fixedHdrSize )
@@ -99,7 +98,7 @@ top of the stack.
 \begin{code}
 cgExpr (StgCon (Literal lit) args res_ty)
   = ASSERT( null args )
-    performPrimReturn (CLit lit)
+    performPrimReturn (text "literal" <+> ppr lit) (CLit lit)
 \end{code}
 
 
@@ -135,7 +134,7 @@ cgExpr x@(StgCon (PrimOp op) args res_ty)
 	    let result_amode = CReg (dataReturnConvPrim kind) in
 	    performReturn 
 	      (COpStmt [result_amode] op arg_amodes [{-no vol_regs-}])
-    	    	    	  (\ sequel -> mkPrimReturnCode sequel)
+	      (mkPrimReturnCode (text "primapp)" <+> ppr x))
 			  
 	-- otherwise, must be returning an enumerated type (eg. Bool).
 	-- we've only got the tag in R2, so we have to load the constructor
@@ -424,26 +423,15 @@ Little helper for primitives that return unboxed tuples.
 \begin{code}
 primRetUnboxedTuple :: PrimOp -> [StgArg] -> Type -> Code
 primRetUnboxedTuple op args res_ty
-  = getArgAmodes args  `thenFC` \ arg_amodes ->		
-    {-
-	put all the arguments in temporaries so they don't get stomped when
-     	we push the return address.
-    -}
-    let 
-	n_args 		  = length args
-	arg_uniqs         = map mkBuiltinUnique [0..n_args-1]
-	arg_reps          = map getArgPrimRep args
-	arg_temps         = zipWith CTemp arg_uniqs arg_reps
-    in
-    absC (mkAbstractCs (zipWith CAssign arg_temps arg_amodes)) `thenC`
-    {-
- 	allocate some temporaries for the return values.
-    -}
-    let 
-	Just (tc,ty_args) = splitAlgTyConAppThroughNewTypes res_ty
+  = let (tc,ty_args) = case splitAlgTyConAppThroughNewTypes res_ty of
+			  Nothing -> pprPanic "primRetUnboxedTuple" (ppr res_ty)
+			  Just pr -> pr
+
 	prim_reps         = map typePrimRep ty_args
-	temp_uniqs        = map mkBuiltinUnique [n_args..n_args+length ty_args-1]
+	temp_uniqs        = map mkBuiltinUnique [0..length ty_args]
 	temp_amodes       = zipWith CTemp temp_uniqs prim_reps
     in
-    returnUnboxedTuple temp_amodes (absC (COpStmt temp_amodes op arg_temps []))
+    returnUnboxedTuple temp_amodes 
+	(getArgAmodes args  `thenFC` \ arg_amodes ->		
+	 absC (COpStmt temp_amodes op arg_amodes []))
 \end{code}
diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs
index bc3f5e5f65..6209ac615d 100644
--- a/ghc/compiler/codeGen/CgHeapery.lhs
+++ b/ghc/compiler/codeGen/CgHeapery.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgHeapery.lhs,v 1.10 1998/12/02 13:17:50 simonm Exp $
+% $Id: CgHeapery.lhs,v 1.11 1998/12/18 17:40:51 simonpj Exp $
 %
 \section[CgHeapery]{Heap management functions}
 
@@ -31,13 +31,12 @@ import ClosureInfo	( closureSize, closureGoodStuffSize,
 			  closureSMRep
 			)
 import PrimRep		( PrimRep(..), isFollowableRep )
-import Util		( panic )
 import CmdLineOpts	( opt_SccProfilingOn )
 import GlaExts
+import Outputable
 
 #ifdef DEBUG
 import PprAbsC		( pprMagicId ) -- tmp
-import Outputable	-- tmp
 #endif
 \end{code}
 
diff --git a/ghc/compiler/codeGen/CgLetNoEscape.lhs b/ghc/compiler/codeGen/CgLetNoEscape.lhs
index b6f20a8290..6d5336c88c 100644
--- a/ghc/compiler/codeGen/CgLetNoEscape.lhs
+++ b/ghc/compiler/codeGen/CgLetNoEscape.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
 %
-% $Id: CgLetNoEscape.lhs,v 1.11 1998/12/02 13:17:50 simonm Exp $
+% $Id: CgLetNoEscape.lhs,v 1.12 1998/12/18 17:40:51 simonpj Exp $
 %
 %********************************************************
 %*							*
diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index 2873b91fa2..757c3d2b7d 100644
--- a/ghc/compiler/codeGen/CgMonad.lhs
+++ b/ghc/compiler/codeGen/CgMonad.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgMonad.lhs,v 1.15 1998/12/02 13:17:50 simonm Exp $
+% $Id: CgMonad.lhs,v 1.16 1998/12/18 17:40:52 simonpj Exp $
 %
 \section[CgMonad]{The code generation monad}
 
@@ -50,6 +50,7 @@ import AbsCSyn
 import AbsCUtils	( mkAbsCStmts )
 import CmdLineOpts	( opt_SccProfilingOn, opt_DoTickyProfiling )
 import CLabel           ( CLabel, mkUpdEntryLabel )
+import OccName		( Module )
 import DataCon		( ConTag )
 import Id		( Id )
 import VarEnv
@@ -86,7 +87,7 @@ data CgInfoDownwards	-- information only passed *downwards* by the monad
 
 data CompilationInfo
   = MkCompInfo
-	FAST_STRING	-- the module name
+	Module		-- the module name
 
 data CgState
   = MkCgState
@@ -533,7 +534,7 @@ getAbsC code info_down (MkCgState absC binds usage)
 
 \begin{code}
 
-moduleName :: FCode FAST_STRING
+moduleName :: FCode Module
 moduleName (MkCgInfoDown (MkCompInfo mod_name) _ _ _) state
   = (mod_name, state)
 
diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs
index c06d2db8be..77a37f373d 100644
--- a/ghc/compiler/codeGen/CgRetConv.lhs
+++ b/ghc/compiler/codeGen/CgRetConv.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP Project, Glasgow University, 1992-1998
 %
-% $Id: CgRetConv.lhs,v 1.15 1998/12/02 13:17:51 simonm Exp $
+% $Id: CgRetConv.lhs,v 1.16 1998/12/18 17:40:52 simonpj Exp $
 %
 \section[CgRetConv]{Return conventions for the code generator}
 
diff --git a/ghc/compiler/codeGen/CgStackery.lhs b/ghc/compiler/codeGen/CgStackery.lhs
index 19d89b0d71..41ec06a885 100644
--- a/ghc/compiler/codeGen/CgStackery.lhs
+++ b/ghc/compiler/codeGen/CgStackery.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgStackery.lhs,v 1.9 1998/12/02 13:17:51 simonm Exp $
+% $Id: CgStackery.lhs,v 1.10 1998/12/18 17:40:53 simonpj Exp $
 %
 \section[CgStackery]{Stack management functions}
 
@@ -25,7 +25,7 @@ import AbsCSyn
 import CgUsages		( getRealSp )
 import AbsCUtils	( mkAbstractCs, mkAbsCStmts, getAmodeRep )
 import PrimRep		( getPrimRepSize, PrimRep(..), isFollowableRep )
-import Util		( panic )
+import Panic		( panic )
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/codeGen/CgTailCall.lhs b/ghc/compiler/codeGen/CgTailCall.lhs
index 81818228e3..772d2fef7c 100644
--- a/ghc/compiler/codeGen/CgTailCall.lhs
+++ b/ghc/compiler/codeGen/CgTailCall.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgTailCall.lhs,v 1.16 1998/12/02 13:17:52 simonm Exp $
+% $Id: CgTailCall.lhs,v 1.17 1998/12/18 17:40:53 simonpj Exp $
 %
 %********************************************************
 %*							*
@@ -53,7 +53,9 @@ import StgSyn		( StgArg, GenStgArg(..) )
 import Type		( isUnLiftedType )
 import TyCon            ( TyCon )
 import PrimOp		( PrimOp )
-import Util		( zipWithEqual, panic, assertPanic )
+import Util		( zipWithEqual )
+import Outputable
+import Panic		( panic, assertPanic )
 \end{code}
 
 %************************************************************************
@@ -94,7 +96,7 @@ Case for unboxed @Ids@ first:
 cgTailCall fun []
   | isUnLiftedType (idType fun)
   = getCAddrMode fun		`thenFC` \ amode ->
-    performPrimReturn amode
+    performPrimReturn (ppr fun) amode
 \end{code}
 
 The general case (@fun@ is boxed):
@@ -109,10 +111,11 @@ cgTailCall fun args = performTailCall fun args
 %************************************************************************
 
 \begin{code}
-performPrimReturn :: CAddrMode	-- The thing to return
+performPrimReturn :: SDoc	-- Just for debugging (sigh)
+		  -> CAddrMode	-- The thing to return
 		  -> Code
 
-performPrimReturn amode
+performPrimReturn doc amode
   = let
 	kind = getAmodeRep amode
 	ret_reg = dataReturnConvPrim kind
@@ -121,11 +124,13 @@ performPrimReturn amode
 	  VoidRep -> AbsCNop
 	  kind -> (CAssign (CReg ret_reg) amode)
     in
-    performReturn assign_possibly mkPrimReturnCode
+    performReturn assign_possibly (mkPrimReturnCode doc)
 
-mkPrimReturnCode :: Sequel -> Code
-mkPrimReturnCode UpdateCode	= panic "mkPrimReturnCode: Upd"
-mkPrimReturnCode sequel		= sequelToAmode sequel	`thenFC` \ dest_amode ->
+mkPrimReturnCode :: SDoc 		-- Debugging only
+		 -> Sequel
+		 -> Code
+mkPrimReturnCode doc UpdateCode	= pprPanic "mkPrimReturnCode: Upd" doc
+mkPrimReturnCode doc sequel	= sequelToAmode sequel	`thenFC` \ dest_amode ->
 				  absC (CReturn dest_amode DirectReturn)
 				  -- Direct, no vectoring
 
diff --git a/ghc/compiler/codeGen/CgUpdate.lhs b/ghc/compiler/codeGen/CgUpdate.lhs
index 32e7b79aab..9164a2edef 100644
--- a/ghc/compiler/codeGen/CgUpdate.lhs
+++ b/ghc/compiler/codeGen/CgUpdate.lhs
@@ -16,7 +16,7 @@ import PrimRep		( PrimRep(..) )
 import CgStackery	( allocUpdateFrame )
 import CgUsages		( getSpRelOffset )
 import CmdLineOpts	( opt_SccProfilingOn )
-import Util		( assertPanic )
+import Panic		( assertPanic )
 \end{code}
 
 
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index 50271c6611..9e99002671 100644
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ b/ghc/compiler/codeGen/ClosureInfo.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: ClosureInfo.lhs,v 1.31 1998/12/02 13:17:55 simonm Exp $
+% $Id: ClosureInfo.lhs,v 1.32 1998/12/18 17:40:54 simonpj Exp $
 %
 \section[ClosureInfo]{Data structures which describe closures}
 
diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 6b97d3fc29..142ee9c1fc 100644
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -34,19 +34,19 @@ import CmdLineOpts	( opt_SccProfilingOn, opt_EnsureSplittableC,
 					      opt_SccGroup
 			)
 import CostCentre       ( CostCentre, CostCentreStack )
-import CStrings		( modnameToC )
 import FiniteMap	( FiniteMap )
 import Id               ( Id, idName )
-import Name             ( Module )
+import Name             ( Module, moduleCString, moduleString )
 import PrimRep		( getPrimRepSize, PrimRep(..) )
 import Type             ( Type )
 import TyCon            ( TyCon )
 import BasicTypes	( TopLevelFlag(..) )
 import Util
+import Panic		( assertPanic )
 \end{code}
 
 \begin{code}
-codeGen :: FAST_STRING		-- module name
+codeGen :: Module		-- module name
 	-> ([CostCentre],	-- local cost-centres needing declaring/registering
 	    [CostCentre],	-- "extern" cost-centres needing declaring
 	    [CostCentreStack])  -- pre-defined "singleton" cost centre stacks
@@ -96,7 +96,7 @@ codeGen mod_name (local_CCs, extern_CCs, singleton_CCSs)
     -----------------
     grp_name  = case opt_SccGroup of
 		  Just xx -> _PK_ xx
-		  Nothing -> mod_name	-- default: module name
+		  Nothing -> _PK_ (moduleString mod_name)	-- default: module name
 
     -----------------
     mkCcRegister ccs cc_stacks import_names
@@ -108,7 +108,7 @@ codeGen mod_name (local_CCs, extern_CCs, singleton_CCSs)
 	in
 	[
 	    CCallProfCCMacro SLIT("START_REGISTER_CCS") 
-	       [ CLitLit (modnameToC (SLIT("_reg") _APPEND_ mod_name)) AddrRep],
+	       [ CLitLit (_PK_ ("_reg" ++ moduleCString mod_name)) AddrRep],
 	    register_ccs,
 	    register_cc_stacks,
 	    register_imports,
@@ -123,7 +123,7 @@ codeGen mod_name (local_CCs, extern_CCs, singleton_CCSs)
 
 	mk_import_register import_name
 	  = CCallProfCCMacro SLIT("REGISTER_IMPORT") 
-	      [CLitLit (modnameToC (SLIT("_reg") _APPEND_ import_name)) AddrRep]
+	      [CLitLit (_PK_ ("_reg" ++ moduleCString import_name)) AddrRep]
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs
index 8270d3eea4..fe463172c6 100644
--- a/ghc/compiler/codeGen/SMRep.lhs
+++ b/ghc/compiler/codeGen/SMRep.lhs
@@ -39,7 +39,6 @@ import Constants	( sTD_HDR_SIZE, pROF_HDR_SIZE,
 			  sTD_ITBL_SIZE, pROF_ITBL_SIZE, 
 			  gRAN_ITBL_SIZE, tICKY_ITBL_SIZE )
 import Outputable
-import Util		( panic )
 import GlaExts		( Int(..), Int#, (<#), (==#), (<#), (>#) )
 \end{code}