2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section{@Vars@: Variables}
8 Var, IdOrTyVar, -- Abstract
9 VarDetails(..), -- Concrete
10 varName, varUnique, varDetails, varInfo, varType,
11 setVarName, setVarUnique, setVarType,
17 tyVarFlexi, setTyVarFlexi, removeTyVarFlexi, setTyVarName, setTyVarUnique,
18 mkFlexiTyVar, mkTyVar, mkSysTyVar, isTyVar, isFlexiTyVar,
22 idName, idType, idUnique, idInfo, modifyIdInfo,
23 setIdName, setIdUnique, setIdInfo,
24 mkId, isId, externallyVisibleId
27 #include "HsVersions.h"
29 import {-# SOURCE #-} Type( GenType, Kind )
30 import {-# SOURCE #-} IdInfo( IdInfo )
31 import {-# SOURCE #-} Const( Con )
33 import FieldLabel ( FieldLabel )
34 import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey )
35 import Name ( Name, NamedThing(..),
36 changeUnique, nameUnique,
37 mkSysLocalName, isExternallyVisibleName
39 import BasicTypes ( Unused )
45 %************************************************************************
47 \subsection{The main data type declarations}
49 %************************************************************************
52 Every @Var@ has a @Unique@, to uniquify it and for fast comparison, a
53 @Type@, and an @IdInfo@ (non-essential info about it, e.g.,
54 strictness). The essential info about different kinds of @Vars@ is
58 type IdOrTyVar = Var Unused Unused
60 data Var flex_self flex_ty
63 realUnique :: Int#, -- Key for fast comparison
64 -- Identical to the Unique in the name,
65 -- cached here for speed
66 varType :: GenType flex_ty,
67 varDetails :: VarDetails flex_self,
68 varInfo :: IdInfo -- Only used for Ids at the moment
71 varUnique Var{realUnique = uniq} = mkUniqueGrimily uniq
73 data VarDetails flex_self
75 | FlexiTyVar flex_self -- Used during unification
76 | VanillaId -- Most Ids are like this
77 | ConstantId Con -- The Id for a constant (data constructor or primop)
78 | RecordSelId FieldLabel -- The Id for a record selector
82 instance Outputable (Var fs ft) where
83 ppr var = ppr (varName var)
85 instance Show (Var fs ft) where
86 showsPrec p var = showsPrecSDoc p (ppr var)
88 instance NamedThing (Var fs ft) where
91 instance Uniquable (Var fs ft) where
94 instance Eq (Var fs ft) where
95 a == b = realUnique a ==# realUnique b
97 instance Ord (Var fs ft) where
98 a <= b = realUnique a <=# realUnique b
99 a < b = realUnique a <# realUnique b
100 a >= b = realUnique a >=# realUnique b
101 a > b = realUnique a ># realUnique b
102 a `compare` b = varUnique a `compare` varUnique b
107 setVarUnique :: Var fs ft -> Unique -> Var fs ft
108 setVarUnique var uniq = var {realUnique = getKey uniq,
109 varName = changeUnique (varName var) uniq}
111 setVarName :: Var fs ft -> Name -> Var fs ft
112 setVarName var new_name
113 = var { realUnique = getKey (getUnique new_name), varName = new_name }
115 setVarType :: Var flex_self flex_ty1 -> GenType flex_ty2 -> Var flex_self flex_ty2
116 setVarType var ty = var {varType = ty}
120 %************************************************************************
122 \subsection{Type variables}
124 %************************************************************************
127 type GenTyVar flex_self = Var flex_self Unused -- Perhaps a mutable tyvar, but
130 type TyVar = GenTyVar Unused -- NOt even mutable
137 setTyVarUnique = setVarUnique
138 setTyVarName = setVarName
140 tyVarFlexi :: GenTyVar flexi -> flexi
141 tyVarFlexi (Var {varDetails = FlexiTyVar flex}) = flex
142 tyVarFlexi other_var = pprPanic "tyVarFlexi" (ppr other_var)
144 setTyVarFlexi :: GenTyVar flexi1 -> flexi2 -> GenTyVar flexi2
145 setTyVarFlexi var flex = var {varDetails = FlexiTyVar flex}
147 removeTyVarFlexi :: GenTyVar flexi1 -> GenTyVar flexi2
148 removeTyVarFlexi var = var {varDetails = TyVar}
152 mkTyVar :: Name -> Kind -> GenTyVar flexi
153 mkTyVar name kind = Var { varName = name, realUnique = getKey (nameUnique name),
154 varType = kind, varDetails = TyVar }
156 mkSysTyVar :: Unique -> Kind -> GenTyVar flexi
157 mkSysTyVar uniq kind = Var { varName = name, realUnique = getKey uniq,
158 varType = kind, varDetails = TyVar }
160 name = mkSysLocalName uniq
162 mkFlexiTyVar :: Name -> Kind -> flexi -> GenTyVar flexi
163 mkFlexiTyVar name kind flex = Var { varName = name,
164 realUnique = getKey (nameUnique name),
166 varDetails = FlexiTyVar flex }
170 isTyVar :: Var fs ft -> Bool
171 isTyVar (Var {varDetails = details}) = case details of
176 isFlexiTyVar :: Var fs ft -> Bool
177 isFlexiTyVar (Var {varDetails = FlexiTyVar _}) = True
178 isFlexiTyVar other = False
182 %************************************************************************
184 \subsection{Id Construction}
186 %************************************************************************
188 Most Id-related functions are in Id.lhs and MkId.lhs
191 type GenId flex_ty = Var Unused flex_ty
192 type Id = GenId Unused
201 idDetails = varDetails
203 setIdUnique :: Id -> Unique -> Id
204 setIdUnique = setVarUnique
206 setIdName :: Id -> Name -> Id
207 setIdName = setVarName
209 setIdInfo :: GenId flexi -> IdInfo -> GenId flexi
210 setIdInfo var info = var {varInfo = info}
212 modifyIdInfo :: GenId flexi -> (IdInfo -> IdInfo) -> GenId flexi
213 modifyIdInfo var@(Var {varInfo = info}) fn = var {varInfo = fn info}
217 mkId :: Name -> GenType flex_ty -> VarDetails Unused -> IdInfo -> GenId flex_ty
218 mkId name ty details info
219 = Var {varName = name, realUnique = getKey (nameUnique name), varType = ty,
220 varDetails = details, varInfo = info}
224 isId :: Var fs ft -> Bool
225 isId (Var {varDetails = details}) = case details of
228 RecordSelId _ -> True
232 @externallyVisibleId@: is it true that another module might be
233 able to ``see'' this Id in a code generation sense. That
234 is, another .o file might refer to this Id.
236 In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
237 local-ness precisely so that the test here would be easy
239 This defn appears here (rather than, say, in Id.lhs) because
240 CostCentre.lhs uses it (CostCentre feeds PprType feeds Id.lhs)
244 externallyVisibleId :: Id -> Bool
245 externallyVisibleId var = isExternallyVisibleName (varName var)