X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FUnique.lhs;h=41806040d26f36750a8fc9bc1a9ad53745ccd269;hp=ee21a0df69bb00b660a44e6c30029790cfae9eaf;hb=5289f5d85610f71625a439747a09384876655eb5;hpb=206b4dec78250efef3cd927d64dc6cbc54a16c3d diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs index ee21a0d..4180604 100644 --- a/compiler/basicTypes/Unique.lhs +++ b/compiler/basicTypes/Unique.lhs @@ -16,19 +16,16 @@ Some of the other hair in this code is to be able to use a Haskell). \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - +{-# LANGUAGE BangPatterns #-} module Unique ( - Unique, Uniquable(..), hasKey, + -- * Main data types + Unique, Uniquable(..), + + -- ** Constructors, desctructors and operations on 'Unique's + hasKey, pprUnique, - mkUnique, -- Used in UniqSupply mkUniqueGrimily, -- Used in UniqSupply only! getKey, getKeyFastInt, -- Used in Var, UniqFM, Name only! @@ -39,6 +36,8 @@ module Unique ( isTupleKey, + -- ** Making built-in uniques + -- now all the built-in Uniques (and functions to make them) -- [the Oh-So-Wonderful Haskell module system wins again...] mkAlphaTyVarUnique, @@ -48,6 +47,9 @@ module Unique ( mkPreludeTyConUnique, mkPreludeClassUnique, mkPArrDataConUnique, + mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, + mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, + mkBuiltinUnique, mkPseudoUniqueC, mkPseudoUniqueD, @@ -57,11 +59,11 @@ module Unique ( #include "HsVersions.h" -import StaticFlags import BasicTypes import FastTypes import FastString import Outputable +-- import StaticFlags #if defined(__GLASGOW_HASKELL__) --just for implementing a fast [0,61) -> Char function @@ -83,6 +85,10 @@ Fast comparison is everything on @Uniques@: \begin{code} --why not newtype Int? + +-- | The type of unique identifiers that are used in many places in GHC +-- for fast ordering and equality tests. You should generate these with +-- the functions from the 'UniqSupply' module data Unique = MkUnique FastInt \end{code} @@ -90,7 +96,6 @@ Now come the functions which construct uniques from their pieces, and vice versa The stuff about unique *supplies* is handled further down this module. \begin{code} -mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces unpkUnique :: Unique -> (Char, Int) -- The reverse mkUniqueGrimily :: Int -> Unique -- A trap-door for UniqSupply @@ -128,11 +133,14 @@ newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u -- and as long as the Char fits in 8 bits, which we assume anyway! +mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces +-- NOT EXPORTED, so that we can see all the Chars that +-- are used in this one module mkUnique c i = MkUnique (tag `bitOrFastInt` bits) where - tag = fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24) - bits = iUnbox i `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-} + !tag = fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24) + !bits = iUnbox i `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-} unpkUnique (MkUnique u) = let @@ -153,6 +161,7 @@ unpkUnique (MkUnique u) %************************************************************************ \begin{code} +-- | Class of things that we can obtain a 'Unique' from class Uniquable a where getUnique :: a -> Unique @@ -178,10 +187,12 @@ use `deriving' because we want {\em precise} control of ordering (equality on @Uniques@ is v common). \begin{code} +eqUnique, ltUnique, leUnique :: Unique -> Unique -> Bool eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2 ltUnique (MkUnique u1) (MkUnique u2) = u1 <# u2 leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2 +cmpUnique :: Unique -> Unique -> Ordering cmpUnique (MkUnique u1) (MkUnique u2) = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT @@ -205,11 +216,9 @@ We do sometimes make strings with @Uniques@ in them: \begin{code} pprUnique :: Unique -> SDoc pprUnique uniq -#ifdef DEBUG - | opt_SuppressUniques - = empty -- Used exclusively to suppress uniques so you - | otherwise -- can compare output easily -#endif +-- | opt_SuppressUniques +-- = empty -- Used exclusively to suppress uniques so you +-- | otherwise -- can compare output easily = case unpkUnique uniq of (tag, u) -> finish_ppr tag u (text (iToBase62 u)) @@ -220,11 +229,12 @@ pprUnique10 uniq -- in base-10, dudes (tag, u) -> finish_ppr tag u (int u) #endif -finish_ppr 't' u pp_u | u < 26 +finish_ppr :: Char -> Int -> SDoc -> SDoc +finish_ppr 't' u _pp_u | u < 26 = -- Special case to make v common tyvars, t1, t2, ... -- come out as a, b, ... (shorter, easier to read) char (chr (ord 'a' + u)) -finish_ppr tag u pp_u = char tag <> pp_u +finish_ppr tag _ pp_u = char tag <> pp_u instance Outputable Unique where ppr u = pprUnique u @@ -261,7 +271,7 @@ iToBase62 n_ #if defined(__GLASGOW_HASKELL__) --then FastInt == Int# chooseChar62 n = C# (indexCharOffAddr# chars62 n) - chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"# + !chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"# #else --Haskell98 arrays are portable chooseChar62 n = (!) chars62 n @@ -282,21 +292,32 @@ Allocation of unique supply characters: X: uniques derived by deriveUnique _: unifiable tyvars (above) 0-9: prelude things below + (no numbers left any more..) + :: (prelude) parallel array data constructors other a-z: lower case chars for unique supplies. Used so far: d desugarer f AbsC flattener g SimplStg - l ndpFlatten n Native codegen r Hsc name cache s simplifier \begin{code} +mkAlphaTyVarUnique :: Int -> Unique +mkPreludeClassUnique :: Int -> Unique +mkPreludeTyConUnique :: Int -> Unique +mkTupleTyConUnique :: Boxity -> Int -> Unique +mkPreludeDataConUnique :: Int -> Unique +mkTupleDataConUnique :: Boxity -> Int -> Unique +mkPrimOpIdUnique :: Int -> Unique +mkPreludeMiscIdUnique :: Int -> Unique +mkPArrDataConUnique :: Int -> Unique + mkAlphaTyVarUnique i = mkUnique '1' i -mkPreludeClassUnique i = mkUnique '2' i +mkPreludeClassUnique i = mkUnique '2' i -- Prelude type constructors occupy *three* slots. -- The first is for the tycon itself; the latter two @@ -321,11 +342,10 @@ mkTupleDataConUnique Unboxed a = mkUnique '8' (2*a) isTupleKey u = case unpkUnique u of (tag,_) -> tag == '4' || tag == '5' || tag == '7' || tag == '8' -mkPrimOpIdUnique op = mkUnique '9' op -mkPreludeMiscIdUnique i = mkUnique '0' i +mkPrimOpIdUnique op = mkUnique '9' op +mkPreludeMiscIdUnique i = mkUnique '0' i --- No numbers left anymore, so I pick something different for the character --- tag +-- No numbers left anymore, so I pick something different for the character tag mkPArrDataConUnique a = mkUnique ':' (2*a) -- The "tyvar uniques" print specially nicely: a, b, c, etc. @@ -342,5 +362,18 @@ mkPseudoUniqueC i = mkUnique 'C' i -- used for getUnique on Regs mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs + +mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique +mkRegSingleUnique = mkUnique 'R' +mkRegSubUnique = mkUnique 'S' +mkRegPairUnique = mkUnique 'P' +mkRegClassUnique = mkUnique 'L' + +mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique +-- See Note [The Unique of an OccName] in OccName +mkVarOccUnique fs = mkUnique 'i' (iBox (uniqueOfFS fs)) +mkDataOccUnique fs = mkUnique 'd' (iBox (uniqueOfFS fs)) +mkTvOccUnique fs = mkUnique 'v' (iBox (uniqueOfFS fs)) +mkTcOccUnique fs = mkUnique 'c' (iBox (uniqueOfFS fs)) \end{code}