X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FUnique.lhs;h=dbfc12a865908d0173ebd2d6485187fbd8f17d36;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=510e7286471b49302c1308a7cc21b81ebe998cb7;hpb=44d7b259d26ff96ec62e155974678f445720b0f8;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs index 510e728..dbfc12a 100644 --- a/ghc/compiler/basicTypes/Unique.lhs +++ b/ghc/compiler/basicTypes/Unique.lhs @@ -17,19 +17,17 @@ Haskell). \begin{code} module Unique ( Unique, Uniquable(..), hasKey, - u2i, -- hack: used in UniqFM - pprUnique, pprUnique10, + pprUnique, mkUnique, -- Used in UniqSupply mkUniqueGrimily, -- Used in UniqSupply only! - getKey, -- Used in Var only! + getKey, getKey#, -- Used in Var, UniqFM, Name only! incrUnique, -- Used for renumbering deriveUnique, -- Ditto newTagUnique, -- Used in CgCase initTyVarUnique, - initTidyUniques, isTupleKey, @@ -40,21 +38,25 @@ module Unique ( mkTupleTyConUnique, mkTupleDataConUnique, mkPreludeMiscIdUnique, mkPreludeDataConUnique, mkPreludeTyConUnique, mkPreludeClassUnique, + mkPArrDataConUnique, mkBuiltinUnique, - mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3 + mkPseudoUniqueC, + mkPseudoUniqueD, + mkPseudoUniqueE, + mkPseudoUniqueH ) where #include "HsVersions.h" import BasicTypes ( Boxity(..) ) import FastString ( FastString, uniqueOfFS ) -import GlaExts -import ST -import PrelBase ( Char(..), chr, ord ) +import Outputable import FastTypes -import Outputable +import GLAEXTS + +import Char ( chr, ord ) \end{code} %************************************************************************ @@ -70,11 +72,6 @@ Fast comparison is everything on @Uniques@: data Unique = MkUnique Int# \end{code} -\begin{code} -u2i :: Unique -> FastInt -u2i (MkUnique i) = i -\end{code} - Now come the functions which construct uniques from their pieces, and vice versa. The stuff about unique *supplies* is handled further down this module. @@ -82,9 +79,9 @@ The stuff about unique *supplies* is handled further down this module. mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces unpkUnique :: Unique -> (Char, Int) -- The reverse -mkUniqueGrimily :: Int# -> Unique -- A trap-door for UniqSupply - -getKey :: Unique -> Int# -- for Var +mkUniqueGrimily :: Int -> Unique -- A trap-door for UniqSupply +getKey :: Unique -> Int -- for Var +getKey# :: Unique -> Int# -- for Var incrUnique :: Unique -> Unique deriveUnique :: Unique -> Int -> Unique @@ -95,10 +92,12 @@ isTupleKey :: Unique -> Bool \begin{code} -mkUniqueGrimily x = MkUnique x +mkUniqueGrimily (I# x) = MkUnique x {-# INLINE getKey #-} -getKey (MkUnique x) = x +getKey (MkUnique x) = I# x +{-# INLINE getKey# #-} +getKey# (MkUnique x) = x incrUnique (MkUnique i) = MkUnique (i +# 1#) @@ -157,10 +156,10 @@ hasKey :: Uniquable a => a -> Unique -> Bool x `hasKey` k = getUnique x == k instance Uniquable FastString where - getUnique fs = mkUniqueGrimily (uniqueOfFS fs) + getUnique fs = mkUniqueGrimily (I# (uniqueOfFS fs)) instance Uniquable Int where - getUnique (I# i#) = mkUniqueGrimily i# + getUnique i = mkUniqueGrimily i \end{code} @@ -200,15 +199,17 @@ instance Uniquable Unique where We do sometimes make strings with @Uniques@ in them: \begin{code} -pprUnique, pprUnique10 :: Unique -> SDoc - +pprUnique :: Unique -> SDoc pprUnique uniq = case unpkUnique uniq of (tag, u) -> finish_ppr tag u (iToBase62 u) +#ifdef UNUSED +pprUnique10 :: Unique -> SDoc pprUnique10 uniq -- in base-10, dudes = case unpkUnique uniq of (tag, u) -> finish_ppr tag u (int u) +#endif finish_ppr 't' u pp_u | u < 26 = -- Special case to make v common tyvars, t1, t2, ... @@ -232,48 +233,21 @@ instance Show Unique where A character-stingy way to read/write numbers (notably Uniques). The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints. Code stolen from Lennart. -\begin{code} -# define BYTE_ARRAY GlaExts.ByteArray -# define RUN_ST ST.runST -# define AND_THEN >>= -# define AND_THEN_ >> -# define RETURN return +\begin{code} iToBase62 :: Int -> SDoc iToBase62 n@(I# n#) = ASSERT(n >= 0) - let -#if __GLASGOW_HASKELL__ < 405 - bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes } -#else - bytes = case chars62 of { BYTE_ARRAY _ _ bytes -> bytes } -#endif - in if n# <# 62# then - case (indexCharArray# bytes n#) of { c -> + case (indexCharOffAddr# chars62# n#) of { c -> char (C# c) } else case (quotRem n 62) of { (q, I# r#) -> - case (indexCharArray# bytes r#) of { c -> + case (indexCharOffAddr# chars62# r#) of { c -> (<>) (iToBase62 q) (char (C# c)) }} - --- keep this at top level! (bug on 94/10/24 WDP) -chars62 :: BYTE_ARRAY Int -chars62 - = RUN_ST ( - newCharArray (0, 61) AND_THEN \ ch_array -> - fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" - AND_THEN_ - unsafeFreezeByteArray ch_array - ) where - fill_in ch_array i lim str - | i == lim - = RETURN () - | otherwise - = writeCharArray ch_array i (str !! i) AND_THEN_ - fill_in ch_array (i+1) lim str + chars62# = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"# \end{code} %************************************************************************ @@ -284,13 +258,22 @@ chars62 Allocation of unique supply characters: v,t,u : for renumbering value-, type- and usage- vars. - other a-z: lower case chars for unique supplies (see Main.lhs) B: builtin C-E: pseudo uniques (used in native-code generator) X: uniques derived by deriveUnique _: unifiable tyvars (above) 0-9: prelude things below + 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 i = mkUnique '1' i @@ -322,21 +305,23 @@ isTupleKey u = case unpkUnique u of mkPrimOpIdUnique op = mkUnique '9' op mkPreludeMiscIdUnique i = mkUnique '0' i +-- 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. -- See pprUnique for details initTyVarUnique :: Unique initTyVarUnique = mkUnique 't' 0 -initTidyUniques :: (Unique, Unique) -- Global and local -initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0) - -mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3, +mkPseudoUniqueC, mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH, mkBuiltinUnique :: Int -> Unique mkBuiltinUnique i = mkUnique 'B' i -mkPseudoUnique1 i = mkUnique 'C' i -- used for getUnique on Regs -mkPseudoUnique2 i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs -mkPseudoUnique3 i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs +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 \end{code}