lookupKeyValue in Development.IDE.Graph.Internal.Key sometimes errors #4653
Description
while trouble shooting something else, I encountered HLS erroring with the following message:
(GhcSessionDeps,NormalizedUri (-1539086352248807771) "inmemory://model/1")IntMap.!: key 15 is not
This comes from lookupKeyValue in Development.IDE.Graph.Internal.Key. The IntMap in that module's type GlobalKeyValueMap which is where the missing key was tried be looked up from, stores the keys to the values in another HashMap, i.e. the type looks as follows:
newtype Key = UnsafeMkKey Int
pattern Key :: () => (Typeable a, Hashable a, Show a) => a -> Key
pattern Key a <- (lookupKeyValue -> KeyValue a _)
{-# COMPLETE Key #-}
data KeyValue = forall a . (Typeable a, Hashable a, Show a) => KeyValue a Text
instance Eq KeyValue where
KeyValue a _ == KeyValue b _ = Just a == cast b
instance Hashable KeyValue where
hashWithSalt i (KeyValue x _) = hashWithSalt i (typeOf x, x)
instance Show KeyValue where
show (KeyValue _ t) = T.unpack t
data GlobalKeyValueMap = GlobalKeyValueMap !(Map.HashMap KeyValue Key) !(IntMap KeyValue) {-# UNPACK #-} !Int
keyMap :: IORef GlobalKeyValueMap
keyMap = unsafePerformIO $ newIORef (GlobalKeyValueMap Map.empty IM.empty 0)
{-# NOINLINE keyMap #-}The Int and the IntMap are related in the sense that the Int is supposed to indicate the next KeyValue to use.
The only way to update the IntMap is by the use of newKey which returns an opaque wrapper around the Int. To my knowledge it is also the only way of obtaining such a Key, since its constructor is not exported:
newKey :: (Typeable a, Hashable a, Show a) => a -> Key
newKey k = unsafePerformIO $ do
traceM $ "inserting new key: " <> show k
let !newKey = KeyValue k (T.pack (show k)) -- FIXME: this is a spaceleak in its purest form (no use for the thing, purely space leak)
atomicModifyIORef' keyMap $ \km@(GlobalKeyValueMap hm im n) ->
let new_key = Map.lookup newKey hm
in case new_key of
Just v -> (km, v)
Nothing ->
let !new_index = UnsafeMkKey n
in (GlobalKeyValueMap (Map.insert newKey new_index hm) (IM.insert n newKey im) (n+1), new_index)
{-# NOINLINE newKey #-}lookupKeyValue :: Key -> KeyValue
lookupKeyValue (UnsafeMkKey x) = unsafePerformIO $ do
GlobalKeyValueMap _ im _ <- readIORef keyMap
pure $! im IM.! xI therefore conclude, that, if newKey wasn't buggy, there'd be no way to ever get the error we've gotten.
Unforunately we do get it though - as to why that is, I don't have a precise explanation. I imagine that the atomicModifyIORef' is not actually executed, my hunches were
new_indexis somehow floated out (I think this is impossible, sincencomes from within theatomicModifyIORef') or something has aborted theatomicModifyIORef'atomicModifyIORef'returns the value but does not actually execute the transaction in the cell (I think this should also be impossible)