[project @ 2000-11-07 15:21:38 by simonmar]

This commit completes the merge of compiler part
	of the HEAD with the before-ghci-branch to
        before-ghci-branch-merged.

ghc/compiler/HsVersions.h

@@ -28,6 +28,15 @@ name = global (value) :: IORef (ty); \
 #define WARN(e,msg)
 #endif
 
+-- temporary usage assertion control KSW 2000-10
+#ifdef DO_USAGES
+#define UASSERT(e) ASSERT(e)
+#define UASSERT2(e,msg) ASSERT2(e,msg)
+#else
+#define UASSERT(e)
+#define UASSERT2(e,msg)
+#endif
+
 #if __STDC__
 #define CAT2(a,b)a##b
 #else

ghc/compiler/basicTypes/Id.lhs

@@ -47,6 +47,7 @@ module Id (
 	setIdArityInfo,
 	setIdDemandInfo,
 	setIdStrictness,
+        setIdTyGenInfo,
 	setIdWorkerInfo,
 	setIdSpecialisation,
 	setIdCafInfo,
@@ -57,6 +58,7 @@ module Id (
 	idFlavour,
 	idDemandInfo,
 	idStrictness,
+        idTyGenInfo,
 	idWorkerInfo,
 	idUnfolding,
 	idSpecialisation,
@@ -82,14 +84,15 @@ import Var		( Id, DictId,
 			)
 import VarSet
 import Type		( Type, tyVarsOfType, typePrimRep, addFreeTyVars, 
-			  seqType, splitTyConApp_maybe )
+                          usOnce, seqType, splitTyConApp_maybe )
 
 import IdInfo 
 
 import Demand		( Demand )
 import Name	 	( Name, OccName,
 			  mkSysLocalName, mkLocalName,
-			  isUserExportedName, getOccName, isIPOcc
+			  isUserExportedName, nameIsLocallyDefined,
+			  getOccName, isIPOcc
 			) 
 import OccName		( UserFS )
 import PrimRep		( PrimRep )
@@ -98,11 +101,13 @@ import FieldLabel	( FieldLabel )
 import SrcLoc		( SrcLoc )
 import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques, 
 			  getNumBuiltinUniques )
+import Outputable
 
 infixl 	1 `setIdUnfolding`,
 	  `setIdArityInfo`,
 	  `setIdDemandInfo`,
 	  `setIdStrictness`,
+	  `setIdTyGenInfo`,
 	  `setIdWorkerInfo`,
 	  `setIdSpecialisation`,
 	  `setInlinePragma`,
@@ -272,7 +277,15 @@ in some other interface unfolding.
 \begin{code}
 omitIfaceSigForId :: Id -> Bool
 omitIfaceSigForId id
-  | otherwise
+  = ASSERT2( not (omit && nameIsLocallyDefined (idName id)
+                       && idTyGenInfo id /= TyGenNever),
+             ppr id )
+    -- mustn't omit type signature for a name whose type might change!
+    omit
+  where
+    omit = omitIfaceSigForId' id
+
+omitIfaceSigForId' id
   = case idFlavour id of
 	RecordSelId _   -> True	-- Includes dictionary selectors
         PrimOpId _      -> True
@@ -331,6 +344,14 @@ setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info)
 isBottomingId :: Id -> Bool
 isBottomingId id = isBottomingStrictness (idStrictness id)
 
+	---------------------------------
+	-- TYPE GENERALISATION
+idTyGenInfo :: Id -> TyGenInfo
+idTyGenInfo id = tyGenInfo (idInfo id)
+
+setIdTyGenInfo :: Id -> TyGenInfo -> Id
+setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) id
+
 	---------------------------------
 	-- WORKER ID
 idWorkerInfo :: Id -> WorkerInfo
@@ -413,11 +434,14 @@ idLBVarInfo :: Id -> LBVarInfo
 idLBVarInfo id = lbvarInfo (idInfo id)
 
 isOneShotLambda :: Id -> Bool
-isOneShotLambda id = case idLBVarInfo id of
-			IsOneShotLambda -> True
-			NoLBVarInfo	-> case splitTyConApp_maybe (idType id) of
-						Just (tycon,_) -> tycon == statePrimTyCon
-						other	       -> False
+isOneShotLambda id = analysis || hack
+  where analysis = case idLBVarInfo id of
+                     LBVarInfo u    | u == usOnce             -> True
+                     other                                    -> False
+        hack     = case splitTyConApp_maybe (idType id) of
+                     Just (tycon,_) | tycon == statePrimTyCon -> True
+                     other                                    -> False
+
 	-- The last clause is a gross hack.  It claims that 
 	-- every function over realWorldStatePrimTy is a one-shot
 	-- function.  This is pretty true in practice, and makes a big
@@ -437,7 +461,7 @@ isOneShotLambda id = case idLBVarInfo id of
 	-- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
 
 setOneShotLambda :: Id -> Id
-setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
+setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
 
 clearOneShotLambda :: Id -> Id
 clearOneShotLambda id 
@@ -457,13 +481,3 @@ zapLamIdInfo :: Id -> Id
 zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
 \end{code}
 
-
-
-
-
-
-
-
-
-
-

ghc/compiler/basicTypes/IdInfo.lhs

@@ -29,9 +29,13 @@ module IdInfo (
 	StrictnessInfo(..),
 	mkStrictnessInfo, noStrictnessInfo,
 	ppStrictnessInfo,isBottomingStrictness, 
-
 	strictnessInfo, setStrictnessInfo, 	
 
+        -- Usage generalisation
+        TyGenInfo(..),
+        tyGenInfo, setTyGenInfo,
+        noTyGenInfo, isNoTyGenInfo, ppTyGenInfo, tyGenInfoString,
+
         -- Worker
         WorkerInfo(..), workerExists, wrapperArity, workerId,
         workerInfo, setWorkerInfo, ppWorkerInfo,
@@ -69,6 +73,7 @@ module IdInfo (
 
 
 import CoreSyn
+import Type		( Type, usOnce )
 import PrimOp	 	( PrimOp )
 import Var              ( Id )
 import BasicTypes	( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
@@ -78,10 +83,13 @@ import BasicTypes	( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBrea
 			)
 import DataCon		( DataCon )
 import FieldLabel	( FieldLabel )
+import Type		( usOnce, usMany )
 import Demand		-- Lots of stuff
 import Outputable	
+import Util		( seqList )
 
 infixl 	1 `setDemandInfo`,
+    	  `setTyGenInfo`,
 	  `setStrictnessInfo`,
 	  `setSpecInfo`,
 	  `setArityInfo`,
@@ -89,6 +97,7 @@ infixl 	1 `setDemandInfo`,
 	  `setUnfoldingInfo`,
 	  `setCprInfo`,
 	  `setWorkerInfo`,
+	  `setLBVarInfo`,
 	  `setCafInfo`,
 	  `setOccInfo`
 	-- infixl so you can say (id `set` a `set` b)
@@ -118,6 +127,7 @@ data IdInfo
 	arityInfo 	:: ArityInfo,		-- Its arity
 	demandInfo 	:: Demand,		-- Whether or not it is definitely demanded
 	specInfo 	:: CoreRules,		-- Specialisations of this function which exist
+        tyGenInfo       :: TyGenInfo,           -- Restrictions on usage-generalisation of this Id
 	strictnessInfo	:: StrictnessInfo,	-- Strictness properties
         workerInfo      :: WorkerInfo,          -- Pointer to Worker Function
 	unfoldingInfo	:: Unfolding,		-- Its unfolding
@@ -137,6 +147,7 @@ megaSeqIdInfo info
     seqArity (arityInfo info)			`seq`
     seqDemand (demandInfo info)			`seq`
     seqRules (specInfo info)			`seq`
+    seqTyGenInfo (tyGenInfo info)               `seq`
     seqStrictnessInfo (strictnessInfo info)	`seq`
     seqWorker (workerInfo info)			`seq`
 
@@ -155,6 +166,7 @@ Setters
 \begin{code}
 setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
 setSpecInfo 	  info sp = PSEQ sp (info { specInfo = sp })
+setTyGenInfo      info tg = tg `seq` info { tyGenInfo = tg }
 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 setOccInfo	  info oc = oc `seq` info { occInfo = oc }
 setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
@@ -203,6 +215,7 @@ mkIdInfo flv = IdInfo {
 		    arityInfo		= UnknownArity,
 		    demandInfo		= wwLazy,
 		    specInfo		= emptyCoreRules,
+                    tyGenInfo		= noTyGenInfo,
 		    workerInfo		= NoWorker,
 		    strictnessInfo	= NoStrictnessInfo,
 		    unfoldingInfo	= noUnfolding,
@@ -348,6 +361,83 @@ instance Show InlinePragInfo where
 \end{code}
 
 
+%************************************************************************
+%*                                                                    *
+\subsection[TyGen-IdInfo]{Type generalisation info about an @Id@}
+%*                                                                    *
+%************************************************************************
+
+Certain passes (notably usage inference) may change the type of an
+identifier, modifying all in-scope uses of that identifier
+appropriately to maintain type safety.
+
+However, some identifiers must not have their types changed in this
+way, because their types are conjured up in the front end of the
+compiler rather than being read from the interface file.  Default
+methods, dictionary functions, record selectors, and others are in
+this category.  (see comment at TcClassDcl.tcClassSig).
+
+To indicate this property, such identifiers are marked TyGenNever.
+
+Furthermore, if the usage inference generates a usage-specialised
+variant of a function, we must NOT re-infer a fully-generalised type
+at the next inference.  This finer property is indicated by a
+TyGenUInfo on the identifier.
+
+\begin{code}
+data TyGenInfo
+  = NoTyGenInfo              -- no restriction on type generalisation
+
+  | TyGenUInfo [Maybe Type]  -- restrict generalisation of this Id to
+                             -- preserve specified usage annotations
+
+  | TyGenNever               -- never generalise the type of this Id
+
+  deriving ( Eq )
+\end{code}
+
+For TyGenUInfo, the list has one entry for each usage annotation on
+the type of the Id, in left-to-right pre-order (annotations come
+before the type they annotate).  Nothing means no restriction; Just
+usOnce or Just usMany forces that annotation to that value.  Other
+usage annotations are illegal.
+
+\begin{code}
+seqTyGenInfo :: TyGenInfo -> ()
+seqTyGenInfo  NoTyGenInfo    = ()
+seqTyGenInfo (TyGenUInfo us) = seqList us ()
+seqTyGenInfo  TyGenNever     = ()
+
+noTyGenInfo :: TyGenInfo
+noTyGenInfo = NoTyGenInfo
+
+isNoTyGenInfo :: TyGenInfo -> Bool
+isNoTyGenInfo NoTyGenInfo = True
+isNoTyGenInfo _           = False
+
+-- NB: There's probably no need to write this information out to the interface file.
+-- Why?  Simply because imported identifiers never get their types re-inferred.
+-- But it's definitely nice to see in dumps, it for debugging purposes.
+
+ppTyGenInfo :: TyGenInfo -> SDoc
+ppTyGenInfo  NoTyGenInfo    = empty
+ppTyGenInfo (TyGenUInfo us) = ptext SLIT("__G") <+> text (tyGenInfoString us)
+ppTyGenInfo  TyGenNever     = ptext SLIT("__G N")
+
+tyGenInfoString us = map go us
+  where go  Nothing               = 'x'  -- for legibility, choose
+        go (Just u) | u == usOnce = '1'  -- chars with identity
+                    | u == usMany = 'M'  -- Z-encoding.
+        go other = pprPanic "IdInfo.tyGenInfoString: unexpected annotation" (ppr other)
+
+instance Outputable TyGenInfo where
+  ppr = ppTyGenInfo
+
+instance Show TyGenInfo where
+  showsPrec p c = showsPrecSDoc p (ppr c)
+\end{code}
+
+
 %************************************************************************
 %*									*
 \subsection[worker-IdInfo]{Worker info about an @Id@}
@@ -495,8 +585,10 @@ work.
 data LBVarInfo
   = NoLBVarInfo
 
-  | IsOneShotLambda		-- The lambda that binds this Id is applied
-				--   at most once
+  | LBVarInfo Type		-- The lambda that binds this Id has this usage
+				--   annotation (i.e., if ==usOnce, then the
+				--   lambda is applied at most once).
+				-- The annotation's kind must be `$'
 				-- HACK ALERT! placing this info here is a short-term hack,
 				--   but it minimises changes to the rest of the compiler.
 				--   Hack agreed by SLPJ/KSW 1999-04.
@@ -510,9 +602,13 @@ noLBVarInfo = NoLBVarInfo
 -- not safe to print or parse LBVarInfo because it is not really a
 -- property of the definition, but a property of the context.
 pprLBVarInfo NoLBVarInfo     = empty
-pprLBVarInfo IsOneShotLambda = getPprStyle $ \ sty ->
-                               if ifaceStyle sty then empty
-                                                 else ptext SLIT("OneShot")
+pprLBVarInfo (LBVarInfo u)   | u == usOnce
+                             = getPprStyle $ \ sty ->
+                               if ifaceStyle sty
+                               then empty
+                               else ptext SLIT("OneShot")
+                             | otherwise
+                             = empty
 
 instance Outputable LBVarInfo where
     ppr = pprLBVarInfo

ghc/compiler/basicTypes/MkId.lhs

@@ -43,8 +43,7 @@ import Rules		( addRule )
 import Type		( Type, ThetaType, mkDictTy, mkDictTys, mkTyConApp, mkTyVarTys,
 			  mkFunTys, mkFunTy, mkSigmaTy,
 			  isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
-			  splitFunTys, splitForAllTys, unUsgTy,
-			  mkUsgTy, UsageAnn(..)
+			  splitFunTys, splitForAllTys
 			)
 import Module		( Module )
 import CoreUtils	( exprType, mkInlineMe )
@@ -79,9 +78,9 @@ import Id		( idType, mkId,
 			)
 import IdInfo		( IdInfo, vanillaIdInfo, mkIdInfo,
 			  exactArity, setUnfoldingInfo, setCafInfo, setCprInfo,
-			  setArityInfo, setSpecInfo,
+			  setArityInfo, setSpecInfo, setTyGenInfo,
 			  mkStrictnessInfo, setStrictnessInfo,
-			  IdFlavour(..), CafInfo(..), CprInfo(..)
+			  IdFlavour(..), CafInfo(..), CprInfo(..), TyGenInfo(..)
 			)
 import FieldLabel	( mkFieldLabel, fieldLabelName, 
 			  firstFieldLabelTag, allFieldLabelTags, fieldLabelType
@@ -143,7 +142,11 @@ mkSpecPragmaId occ uniq ty loc
 	-- Maybe a SysLocal?  But then we'd lose the location
 
 mkDefaultMethodId dm_name rec_c ty
-  = mkVanillaId dm_name ty
+  = mkId dm_name ty info
+  where
+    info = vanillaIdInfo `setTyGenInfo` TyGenNever
+             -- type is wired-in (see comment at TcClassDcl.tcClassSig), so
+             -- do not generalise it
 
 mkWorkerId uniq unwrkr ty
   = mkVanillaId (mkDerivedName mkWorkerOcc (getName unwrkr) uniq) ty
@@ -243,6 +246,9 @@ mkDataConWrapId data_con
 		-- The wrapper Id ends up in STG code as an argument,
 		-- sometimes before its definition, so we want to
 		-- signal that it has no CAFs
+           `setTyGenInfo`     TyGenNever
+                -- No point generalising its type, since it gets eagerly inlined
+                -- away anyway
 
     wrap_ty = mkForAllTys all_tyvars $
 	      mkFunTys all_arg_tys
@@ -413,6 +419,7 @@ mkRecordSelId tycon field_label unpack_id unpackUtf8_id
 	   `setArityInfo`	exactArity (1 + length dict_tys)
 	   `setUnfoldingInfo`	unfolding	
 	   `setCafInfo`		NoCafRefs
+           `setTyGenInfo`	TyGenNever
 	-- ToDo: consider adding further IdInfo
 
     unfolding = mkTopUnfolding sel_rhs
@@ -428,7 +435,7 @@ mkRecordSelId tycon field_label unpack_id unpackUtf8_id
 	      mkLams dict_ids $ Lam data_id $
 	      sel_body
 
-    sel_body | isNewTyCon tycon = Note (Coerce (unUsgTy field_tau) (unUsgTy data_ty)) (Var data_id)
+    sel_body | isNewTyCon tycon = Note (Coerce field_tau data_ty) (Var data_id)
 	     | otherwise	= Case (Var data_id) data_id (the_alts ++ default_alt)
 
     mk_maybe_alt data_con 
@@ -446,8 +453,7 @@ mkRecordSelId tycon field_label unpack_id unpackUtf8_id
     	    maybe_the_arg_id  = assocMaybe (field_lbls `zip` arg_ids) field_label
     	    field_lbls	      = dataConFieldLabels data_con
 
-    error_expr = mkApps (Var rEC_SEL_ERROR_ID) [Type (unUsgTy field_tau), err_string]
-       -- preserves invariant that type args are *not* usage-annotated on top.  KSW 1999-04.
+    error_expr = mkApps (Var rEC_SEL_ERROR_ID) [Type field_tau, err_string]
     err_string
         | all safeChar full_msg
             = App (Var unpack_id) (Lit (MachStr (_PK_ full_msg)))
@@ -524,6 +530,7 @@ mkDictSelId name clas
 		`setArityInfo`	    exactArity 1
 		`setUnfoldingInfo`  unfolding
 		`setCafInfo`	    NoCafRefs
+                `setTyGenInfo`      TyGenNever
 		
 	-- We no longer use 'must-inline' on record selectors.  They'll
 	-- inline like crazy if they scrutinise a constructor
@@ -622,9 +629,12 @@ mkDictFunId :: Name		-- Name to use for the dict fun;
 	    -> Id
 
 mkDictFunId dfun_name clas inst_tyvars inst_tys dfun_theta
-  = mkVanillaId dfun_name dfun_ty
+  = mkId dfun_name dfun_ty info
   where
     dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
+    info = vanillaIdInfo `setTyGenInfo` TyGenNever
+             -- type is wired-in (see comment at TcClassDcl.tcClassSig), so
+             -- do not generalise it
 
 {-  1 dec 99: disable the Mark Jones optimisation for the sake
     of compatibility with Hugs.
@@ -810,9 +820,8 @@ openAlphaTy  = mkTyVarTy openAlphaTyVar
 openBetaTy   = mkTyVarTy openBetaTyVar
 
 errorTy  :: Type
-errorTy  = mkUsgTy UsMany $
-           mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkUsgTy UsOnce (mkListTy charTy)] 
-                                                   (mkUsgTy UsMany openAlphaTy))
+errorTy  = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] 
+                                                   openAlphaTy)
     -- Notice the openAlphaTyVar.  It says that "error" can be applied
     -- to unboxed as well as boxed types.  This is OK because it never
     -- returns, so the return type is irrelevant.

ghc/compiler/basicTypes/OccName.lhs

@@ -8,7 +8,7 @@
 module OccName (
 	-- The NameSpace type; abstact
 	NameSpace, tcName, clsName, tcClsName, dataName, varName, ipName,
-	tvName, uvName, nameSpaceString, 
+	tvName, nameSpaceString, 
 
 	-- The OccName type
 	OccName, 	-- Abstract, instance of Outputable
@@ -20,7 +20,7 @@ module OccName (
  	mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
 	mkGenOcc1, mkGenOcc2, 
 	
-	isSysOcc, isTvOcc, isUvOcc, isDataOcc, isDataSymOcc, isSymOcc, isIPOcc, isValOcc,
+	isSysOcc, isTvOcc, isDataOcc, isDataSymOcc, isSymOcc, isIPOcc, isValOcc,
 
 	occNameFS, occNameString, occNameUserString, occNameSpace, occNameFlavour, 
 	setOccNameSpace,
@@ -86,7 +86,6 @@ data NameSpace = VarName	-- Variables
 	       | IPName		-- Implicit Parameters
 	       | DataName	-- Data constructors
 	       | TvName		-- Type variables
-	       | UvName		-- Usage variables
 	       | TcClsName	-- Type constructors and classes; Haskell has them
 				-- in the same name space for now.
 	       deriving( Eq, Ord )
@@ -99,7 +98,6 @@ tcClsName = TcClsName		-- Not sure which!
 
 dataName = DataName
 tvName   = TvName
-uvName   = UvName
 varName  = VarName
 ipName   = IPName
 
@@ -109,7 +107,6 @@ nameSpaceString DataName  = "Data constructor"
 nameSpaceString VarName   = "Variable"
 nameSpaceString IPName    = "Implicit Param"
 nameSpaceString TvName    = "Type variable"
-nameSpaceString UvName    = "Usage variable"
 nameSpaceString TcClsName = "Type constructor or class"
 \end{code}
 
@@ -177,7 +174,7 @@ mkCCallOcc :: EncodedString -> OccName
 -- But then alreadyEncoded complains about the braces!
 mkCCallOcc str = OccName varName (_PK_ str)
 
--- Kind constructors get a speical function.  Uniquely, they are not encoded,
+-- Kind constructors get a special function.  Uniquely, they are not encoded,
 -- so that they have names like '*'.  This means that *even in interface files*
 -- we'll get kinds like (* -> (* -> *)).  We can't use mkSysOcc because it
 -- has an ASSERT that doesn't hold.
@@ -225,14 +222,11 @@ occNameFlavour (OccName sp _) = nameSpaceString sp
 \end{code}
 
 \begin{code}
-isTvOcc, isDataSymOcc, isSymOcc, isUvOcc :: OccName -> Bool
+isTvOcc, isDataSymOcc, isSymOcc :: OccName -> Bool
 
 isTvOcc (OccName TvName _) = True
 isTvOcc other              = False
 
-isUvOcc (OccName UvName _) = True
-isUvOcc other              = False
-
 isValOcc (OccName VarName  _) = True
 isValOcc (OccName DataName _) = True
 isValOcc other		      = False

ghc/compiler/basicTypes/Var.hi-boot

@@ -6,6 +6,5 @@ _declarations_
 -- Used by Name
 1 type Id = Var ;
 1 type TyVar = Var ;
-1 type UVar = Var ;
 1 data Var ;
 1 setIdName _:_ Id -> Name.Name -> Id ;;

ghc/compiler/basicTypes/Var.hi-boot-5

@@ -3,7 +3,6 @@ __export Var Var TyVar Id setIdName ;
 -- Used by Name
 1 type Id = Var;
 1 type TyVar = Var;
-1 type UVar = Var;
 1 data Var ;
 1 setIdName :: Id -> Name.Name -> Id ;
 

ghc/compiler/basicTypes/Var.lhs

@@ -17,11 +17,6 @@ module Var (
 	newMutTyVar, newSigTyVar,
 	readMutTyVar, writeMutTyVar, isMutTyVar, makeTyVarImmutable,
 
-        -- UVars
-        UVar,
-        isUVar,
-        mkUVar, mkNamedUVar,
-
 	-- Ids
 	Id, DictId,
 	idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo,
@@ -76,7 +71,6 @@ data VarDetails
   | MutTyVar (IORef (Maybe Type)) 	-- Used during unification;
 	     Bool			-- True <=> this is a type signature variable, which
 					--	    should not be unified with a non-tyvar type
-  | UVar                                -- Usage variable
 
 -- For a long time I tried to keep mutable Vars statically type-distinct
 -- from immutable Vars, but I've finally given up.   It's just too painful.
@@ -212,43 +206,6 @@ isSigTyVar other			          = False
 \end{code}
 
 
-%************************************************************************
-%*									*
-\subsection{Usage variables}
-%*									*
-%************************************************************************
-
-\begin{code}
-type UVar = Var
-\end{code}
-
-\begin{code}
-mkUVar :: Unique -> UVar
-mkUVar unique = Var { varName    = name
-		    , realUnique = getKey unique
-		    , varDetails = UVar
-		    , varType    = pprPanic "mkUVar (varType)" (ppr name)
-		    , varInfo    = pprPanic "mkUVar (varInfo)" (ppr name)
-		    }
-	      where name = mkSysLocalName unique SLIT("u")
-
-mkNamedUVar :: Name -> UVar
-mkNamedUVar name = Var { varName    = name
-		       , realUnique = getKey (nameUnique name)
-		       , varDetails = UVar
-		       , varType    = pprPanic "mkNamedUVar (varType)" (ppr name)
-		       , varInfo    = pprPanic "mkNamedUVar (varInfo)" (ppr name)
-		       }
-\end{code}
-
-\begin{code}
-isUVar :: Var -> Bool
-isUVar (Var {varDetails = details}) = case details of
-					UVar	   -> True
-					other	   -> False
-\end{code}
-
-
 %************************************************************************
 %*									*
 \subsection{Id Construction}

ghc/compiler/basicTypes/VarSet.lhs

@@ -5,7 +5,7 @@
 
 \begin{code}
 module VarSet (
-	VarSet, IdSet, TyVarSet, UVarSet,
+	VarSet, IdSet, TyVarSet,
 	emptyVarSet, unitVarSet, mkVarSet,
 	extendVarSet, extendVarSet_C,
 	elemVarSet, varSetElems, subVarSet,
@@ -18,7 +18,7 @@ module VarSet (
 
 #include "HsVersions.h"
 
-import Var		( Var, Id, TyVar, UVar )
+import Var		( Var, Id, TyVar )
 import Unique		( Unique )
 import UniqSet
 import UniqFM		( delFromUFM_Directly, addToUFM_C )
@@ -34,7 +34,6 @@ import UniqFM		( delFromUFM_Directly, addToUFM_C )
 type VarSet       = UniqSet Var
 type IdSet 	  = UniqSet Id
 type TyVarSet	  = UniqSet TyVar
-type UVarSet      = UniqSet UVar
 
 emptyVarSet	:: VarSet
 intersectVarSet	:: VarSet -> VarSet -> VarSet

ghc/compiler/codeGen/CgCase.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.47 2000/11/07 13:12:22 simonpj Exp $
+% $Id: CgCase.lhs,v 1.48 2000/11/07 15:21:39 simonmar Exp $
 %
 %********************************************************
 %*							*
@@ -874,7 +874,7 @@ restoreCurrentCostCentre (Just slot)
    freeStackSlots [slot]			 `thenC`
    returnFC (CCallProfCCMacro SLIT("RESTORE_CCCS") [CVal sp_rel CostCentreRep])
     -- we use the RESTORE_CCCS macro, rather than just
-    -- assigning into CurCostCentre, in case RESTORE_CCC
+    -- assigning into CurCostCentre, in case RESTORE_CCCS
     -- has some sanity-checking in it.
 \end{code}
 

ghc/compiler/coreSyn/CoreSyn.lhs

@@ -49,7 +49,7 @@ module CoreSyn (
 
 import CostCentre	( CostCentre, noCostCentre )
 import Var		( Var, Id, TyVar, isTyVar, isId )
-import Type		( Type, UsageAnn, mkTyVarTy, seqType )
+import Type		( Type, mkTyVarTy, seqType )
 import Literal	        ( Literal, mkMachInt )
 import DataCon		( DataCon, dataConId )
 import VarSet
@@ -103,9 +103,6 @@ data Note
 
   | InlineMe		-- Instructs simplifer to treat the enclosed expression
 			-- as very small, and inline it at its call sites
-
-  | TermUsg             -- A term-level usage annotation
-        UsageAnn        -- (should not be a variable except during UsageSP inference)
 \end{code}
 
 

ghc/compiler/coreSyn/CoreUtils.lhs

@@ -55,9 +55,9 @@ import IdInfo		( LBVarInfo(..),
 			  megaSeqIdInfo )
 import Demand		( appIsBottom )
 import Type		( Type, mkFunTy, mkForAllTy,
-			  splitFunTy_maybe, 
-                          isNotUsgTy, mkUsgTy, unUsgTy, UsageAnn(..),
-			  applyTys, isUnLiftedType, seqType
+			  splitFunTy_maybe, tyVarsOfType, tyVarsOfTypes,
+			  applyTys, isUnLiftedType, seqType,
+                          mkUTy
 			)
 import TysWiredIn	( boolTy, trueDataCon, falseDataCon )
 import CostCentre	( CostCentre )
@@ -81,7 +81,6 @@ exprType (Lit lit)		= literalType lit
 exprType (Let _ body)	   	= exprType body
 exprType (Case _ _ alts)        = coreAltsType alts
 exprType (Note (Coerce ty _) e) = ty  -- **! should take usage from e
-exprType (Note (TermUsg u) e)   = mkUsgTy u (unUsgTy (exprType e))
 exprType (Note other_note e)    = exprType e