I was stuck with a weird performance problem: With no apparent reason my runtime exploded from 127 ms to 140s, that is 1000 fold.
I narrowed the problem down and finally found it: Removing
{-# LANGUAGE AllowAmbiguousTypes #-}
and rewriting my type application with a concrete type, runtime was back to 127 ms.
I have one suspicion and a couple of questions …
This is the code that gets executed roughly 1000 times (I try to reduce to the relevant stuff):
First the fast version, w/o the problem.
optimizeStenoSeries
:: forall key
. Palantype key
=> ByteString
-> Result key
optimizeStenoSeries str =
-- ...
Trie.matches primitives str
-- ...
-- a ByteString trie
primitives :: Trie RawSteno
primitives =
let str = $(embedFile "primitives.json")
primMap = case Aeson.decodeStrict str of
-- correctly parse the file, given the type Key
Right m -> m :: PrimMap Key
Left err -> -- ...
in Trie.fromList $ Map.toList unPrimMap primMap
In the slow version with AllowAmbiguousTypes
, primitives
looks like this:
primitives :: forall key. Palantype key => Trie RawSteno
primitives =
let str = $(embedFile "primitives.json")
primMap = case Aeson.decodeStrict str of
-- correctly parse the file, depending on the key type-variable
Right m -> m :: PrimMap key
Left err -> -- ...
in Trie.fromList $ Map.toList unPrimMap primMap
and the function gets called by optimizeStenoSeries
by means of type application:
Trie.matches (primitives @key) str
I conclude that in the slow version, the json-file gets parsed again and again, whereas in the quick version primitives
always refers to the same trie, efficiently parsed once and kept in memory.
But why?
And: Is this conclusion correct?
Could something similar happen with regular arguments instead of a type application?
How can I avoid that?
EDIT: I quickly replaced the type application with the old-school Proxy :: Proxy key
argument and removed AllowAmbiguousTypes
. The resulting code suffers from the same problem. I changed the title of the question, to reflect that. My questions remain the same.