[project @ 2000-10-12 13:11:45 by simonmar]

[ghc-hetmet.git] / ghc / compiler / basicTypes / Var.lhs

diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs
index 4d5be70..89bef36 100644 (file)
--- a/ghc/compiler/basicTypes/Var.lhs
+++ b/ghc/compiler/basicTypes/Var.lhs
@@ -5,11 +5,10 @@
 
 \begin{code}
 module Var (
-       Var, IdOrTyVar, VarDetails,             -- Abstract
+       Var, VarDetails,                -- Abstract
        varName, varUnique, varInfo, varType,
        setVarName, setVarUnique, setVarType, setVarOcc,
 
-
        -- TyVars
        TyVar,
        tyVarName, tyVarKind,
@@ -21,33 +20,32 @@ module Var (
         -- UVars
         UVar,
         isUVar,
-        mkUVar,
+        mkUVar, mkNamedUVar,
 
        -- Ids
        Id, DictId,
        idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo,
-       setIdName, setIdUnique, setIdInfo,
+       setIdName, setIdUnique, setIdInfo, lazySetIdInfo, zapIdInfo,
        mkIdVar, isId, externallyVisibleId
     ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}  Type( Type, Kind )
-import {-# SOURCE #-}  IdInfo( IdInfo )
+import {-# SOURCE #-}  TypeRep( Type, Kind )
+import {-# SOURCE #-}  IdInfo( IdInfo, seqIdInfo, vanillaIdInfo )
 
 import Unique          ( Unique, Uniquable(..), mkUniqueGrimily, getKey )
 import Name            ( Name, OccName, NamedThing(..),
                          setNameUnique, setNameOcc, nameUnique, 
                          mkSysLocalName, isExternallyVisibleName
                        )
-import BasicTypes      ( Unused )
+import FastTypes
 import Outputable
 
 import IOExts          ( IORef, newIORef, readIORef, writeIORef )
 \end{code}
 
 
-
 %************************************************************************
 %*                                                                     *
 \subsection{The main data type declarations}
@@ -61,12 +59,10 @@ strictness).  The essential info about different kinds of @Vars@ is
 in its @VarDetails@.
 
 \begin{code}
-type IdOrTyVar = Var
-
 data Var
   = Var {
        varName    :: Name,
-       realUnique :: Int#,             -- Key for fast comparison
+       realUnique :: FastInt,          -- Key for fast comparison
                                        -- Identical to the Unique in the name,
                                        -- cached here for speed
        varType    :: Type,
@@ -118,8 +114,9 @@ varUnique :: Var -> Unique
 varUnique (Var {realUnique = uniq}) = mkUniqueGrimily uniq
 
 setVarUnique :: Var -> Unique -> Var
-setVarUnique var uniq = var {realUnique = getKey uniq, 
-                            varName = setNameUnique (varName var) uniq}
+setVarUnique var@(Var {varName = name}) uniq 
+  = var {realUnique = getKey uniq, 
+        varName = setNameUnique name uniq}
 
 setVarName :: Var -> Name -> Var
 setVarName var new_name
@@ -158,9 +155,7 @@ mkTyVar name kind = Var { varName    = name
                        , realUnique = getKey (nameUnique name)
                        , varType    = kind
                        , varDetails = TyVar
-#ifdef DEBUG
-                       , varInfo = pprPanic "looking at IdInfo of a tyvar" (ppr name)
-#endif
+                       , varInfo    = pprPanic "mkTyVar" (ppr name)
                        }
 
 mkSysTyVar :: Unique -> Kind -> TyVar
@@ -168,28 +163,29 @@ mkSysTyVar uniq kind = Var { varName    = name
                           , realUnique = getKey uniq
                           , varType    = kind
                           , varDetails = TyVar
-#ifdef DEBUG
-                          , varInfo = pprPanic "mkSysTyVar" (ppr name)
-#endif
+                          , varInfo    = pprPanic "mkSysTyVar" (ppr name)
                           }
                     where
                       name = mkSysLocalName uniq SLIT("t")
 
 newMutTyVar :: Name -> Kind -> IO TyVar
-newMutTyVar name kind = 
-  do loc <- newIORef Nothing
-     return (Var { varName = name, 
-                  realUnique = getKey (nameUnique name),
-                  varType = kind, 
-                  varDetails = MutTyVar loc False})
+newMutTyVar name kind = newTyVar name kind False
 
 newSigTyVar :: Name -> Kind -> IO TyVar
-newSigTyVar name kind = 
-  do loc <- newIORef Nothing
-     return (Var { varName = name, 
-                  realUnique = getKey (nameUnique name),
-                  varType = kind, 
-                  varDetails = MutTyVar loc True})
+-- Type variables from type signatures are still mutable, because
+-- they may get unified with type variables from other signatures
+-- But they do contain a flag to distinguish them, so we can tell if
+-- we unify them with a non-type-variable.
+newSigTyVar name kind = newTyVar name kind True
+
+newTyVar name kind is_sig
+ = do loc <- newIORef Nothing
+      return (Var { varName    = name
+                 , realUnique = getKey (nameUnique name)
+                 , varType    = kind
+                 , varDetails = MutTyVar loc is_sig
+                 , varInfo    = pprPanic "newMutTyVar" (ppr name)
+                 })
 
 readMutTyVar :: TyVar -> IO (Maybe Type)
 readMutTyVar (Var {varDetails = MutTyVar loc _}) = readIORef loc
@@ -228,9 +224,21 @@ type UVar = Var
 
 \begin{code}
 mkUVar :: Unique -> UVar
-mkUVar unique = Var { varName    = mkSysLocalName unique SLIT("u"),
-                     realUnique = getKey unique,
-                     varDetails = 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}
@@ -266,11 +274,21 @@ setIdUnique = setVarUnique
 setIdName :: Id -> Name -> Id
 setIdName = setVarName
 
+lazySetIdInfo :: Id -> IdInfo -> Id
+lazySetIdInfo var info = var {varInfo = info}
+
 setIdInfo :: Id -> IdInfo -> Id
-setIdInfo var info = var {varInfo = info}
+setIdInfo var info = seqIdInfo info `seq` var {varInfo = info}
+       -- Try to avoid spack leaks by seq'ing
+
+zapIdInfo :: Id -> Id
+zapIdInfo var = var {varInfo = vanillaIdInfo}
 
 modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
-modifyIdInfo fn var@(Var {varInfo = info}) = var {varInfo = fn info}
+modifyIdInfo fn var@(Var {varInfo = info})
+  = seqIdInfo new_info `seq` var {varInfo = new_info}
+  where
+    new_info = fn info
 
 -- maybeModifyIdInfo tries to avoid unnecesary thrashing
 maybeModifyIdInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id