Commit fb6c708f authored by Travis Whitaker's avatar Travis Whitaker

Check that uniques actually are.

parent b9f7c08f
......@@ -33,6 +33,10 @@ module GHC.Types.Unique.Supply (
initUniqSupply
) where
import Control.Concurrent.MVar
import qualified Data.IntSet as I
import GHC.Prelude
import GHC.Types.Unique
......@@ -45,6 +49,8 @@ import Control.Monad
import Data.Bits
import Data.Char
import System.IO
#include "Unique.h"
{-
......@@ -83,9 +89,28 @@ uniqsFromSupply :: UniqSupply -> [Unique] -- Infinite
takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
-- ^ Obtain the 'Unique' from this particular 'UniqSupply', and a new supply
putStrLnErr :: String -> IO ()
putStrLnErr = hPutStrLn stderr
uniqSymSet :: MVar I.IntSet
uniqSymSet = unsafePerformIO (newMVar I.empty)
chkSymUniq :: Int -> IO Bool
chkSymUniq n = do
s <- takeMVar uniqSymSet
let b = I.member n s
when b
(putStrLnErr (unlines [ "Duplicate uniqFromMask sym: " ++ show n
, "map is: " ++ show s
]))
putMVar uniqSymSet (I.insert n s)
pure b
uniqFromMask :: Char -> IO Unique
uniqFromMask mask
= do { uqNum <- genSym
; b <- chkSymUniq uqNum
; when b (panic ("uniqFromMask failed: " ++ show uqNum))
; return $! mkUnique mask uqNum }
mkSplitUniqSupply c
......
......@@ -67,7 +67,7 @@ ghc_stage2_CONFIGURE_OPTS += -f-threaded
ghc_stage3_CONFIGURE_OPTS += -f-threaded
endif
# Stage-0 compiler isn't guaranteed to have a threaded RTS.
ghc_stage1_CONFIGURE_OPTS += -f-threaded
# ghc_stage1_CONFIGURE_OPTS += -f-threaded
ifeq "$(GhcProfiled)" "YES"
ghc_stage2_PROGRAM_WAY = p
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment