eb1018c · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Improve performance of type-class dict lookup

We previously filtered ALL type-class dictionaries every time we had an import. We previously stored dictionaries in a Map keyed by identifier and module name. We never actually used that key. We now store a list of dictionaries by module name and look them up by that name when we have an import. Here's some numbers from Criterion: benchmarking unpatched time 142.9 s (133.9 s .. 149.8 s) 1.000 R² (0.998 R² .. 1.000 R²) mean 145.8 s (144.0 s .. 146.9 s) std dev 1.699 s (0.0 s .. 1.938 s) variance introduced by outliers: 19% (moderately inflated) benchmarking patched time 56.14 s (41.02 s .. 68.60 s) 0.992 R² (0.969 R² .. 1.000 R²) mean 58.99 s (56.64 s .. 60.73 s) std dev 2.642 s (0.0 s .. 3.008 s) variance introduced by outliers: 19% (moderately inflated)

commiteb1018c2b5571821ba1df1d94535a31525c5bb79 authorBrian McKenna <brian@brianmckenna.org> dateWed 10 Jun 2015, 16:10 (11 years ago) parent57f0976

4 files changed+14−9

compare with golang

unifiedsplit

src/Language/PureScript/CodeGen/Externs.hs+1−1 src/Language/PureScript/Environment.hs+1−1 src/Language/PureScript/TypeChecker.hs+3−4 src/Language/PureScript/TypeChecker/Monad.hs+9−3

src/Language/PureScript/CodeGen/Externs.hs+1−1

@@ -107,7 +107,7 @@ moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWri

107107

108108 exportToPs (TypeInstanceRef ident) = do

109109 let TypeClassDictionaryInScope { tcdClassName = className, tcdInstanceTypes = tys, tcdDependencies = deps} =

110− fromMaybe (error $ "Type class instance has no dictionary in exportToPs") . find (\tcd -> tcdName tcd == Qualified (Just moduleName) ident && tcdType tcd == TCDRegular) $ M.elems $ typeClassDictionaries env

110+ fromMaybe (error $ "Type class instance has no dictionary in exportToPs") . find (\tcd -> tcdName tcd == Qualified (Just moduleName) ident && tcdType tcd == TCDRegular) . maybe [] M.elems . M.lookup (Just moduleName) $ typeClassDictionaries env

111111 let constraintsText = case fromMaybe [] deps of

112112 [] -> ""

113113 cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom tys')) cs) ++ ") => "

src/Language/PureScript/Environment.hs+1−1

@@ -49,7 +49,7 @@ data Environment = Environment {

4949 -- |

5050 -- Available type class dictionaries

5151 --

52− , typeClassDictionaries :: M.Map (Qualified Ident, Maybe ModuleName) TypeClassDictionaryInScope

52+ , typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified Ident) TypeClassDictionaryInScope)

5353 -- |

5454 -- Type classes

5555 --

src/Language/PureScript/TypeChecker.hs+3−4

@@ -90,8 +90,8 @@ addTypeClass moduleName pn args implies ds =

9090

9191addTypeClassDictionaries :: [TypeClassDictionaryInScope] -> Check ()

9292addTypeClassDictionaries entries =

93− let mentries = M.fromList [ ((canonicalizeDictionary entry, mn), entry) | entry@TypeClassDictionaryInScope{ tcdName = Qualified mn _ } <- entries ]

94− in modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = (typeClassDictionaries . checkEnv $ st) `M.union` mentries } }

93+ let mentries = M.fromListWith (M.union) [ (mn, M.singleton (canonicalizeDictionary entry) entry) | entry@TypeClassDictionaryInScope{ tcdName = Qualified mn _ } <- entries ]

94+ in modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = M.unionWith (M.union) (typeClassDictionaries . checkEnv $ st) mentries } }

9595

9696checkDuplicateTypeArguments :: [String] -> Check ()

9797checkDuplicateTypeArguments args = for_ firstDup $ \dup ->

@@ -223,8 +223,7 @@ typeCheckAll mainModuleName moduleName exps = go

223223 guardWith (errorMessage (OrphanFixityDeclaration name)) $ M.member (moduleName, Op name) $ names env

224224 return $ d : ds

225225 go (d@(ImportDeclaration importedModule _ _) : rest) = do

226− tcds <- getTypeClassDictionaries

227− let instances = filter (\tcd -> let Qualified (Just mn) _ = tcdName tcd in importedModule == mn) tcds

226+ instances <- lookupTypeClassDictionaries $ Just importedModule

228227 addTypeClassDictionaries [ tcd { tcdName = Qualified (Just moduleName) ident, tcdType = TCDAlias (canonicalizeDictionary tcd) }

229228 | tcd <- instances

230229 , tcdExported tcd

src/Language/PureScript/TypeChecker/Monad.hs+9−3

@@ -69,8 +69,8 @@ withScopedTypeVars mn ks = bindTypes (M.fromList (map (\(name, k) -> (Qualified

6969withTypeClassDictionaries :: (MonadState CheckState m) => [TypeClassDictionaryInScope] -> m a -> m a

7070withTypeClassDictionaries entries action = do

7171 orig <- get

72− let mentries = M.fromList [ ((canonicalizeDictionary entry, mn), entry) | entry@TypeClassDictionaryInScope{ tcdName = Qualified mn _ } <- entries ]

73− modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = (typeClassDictionaries . checkEnv $ st) `M.union` mentries } }

72+ let mentries = M.fromListWith (M.union) [ (mn, M.singleton (canonicalizeDictionary entry) entry) | entry@TypeClassDictionaryInScope{ tcdName = Qualified mn _ } <- entries ]

73+ modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = M.unionWith (M.union) (typeClassDictionaries . checkEnv $ st) mentries } }

7474 a <- action

7575 modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = typeClassDictionaries . checkEnv $ orig } }

7676 return a

@@ -79,7 +79,13 @@ withTypeClassDictionaries entries action = do

7979-- Get the currently available list of type class dictionaries

8080--

8181getTypeClassDictionaries :: (Functor m, MonadState CheckState m) => m [TypeClassDictionaryInScope]

82−getTypeClassDictionaries = M.elems . typeClassDictionaries . checkEnv <$> get

82+getTypeClassDictionaries = (>>= M.elems) . M.elems . typeClassDictionaries . checkEnv <$> get

83+

84+-- |

85+-- Lookup type class dictionaries in a module.

86+--

87+lookupTypeClassDictionaries :: (Functor m, MonadState CheckState m) => Maybe ModuleName -> m [TypeClassDictionaryInScope]

88+lookupTypeClassDictionaries mn = maybe [] M.elems . M.lookup mn . typeClassDictionaries . checkEnv <$> get

8389

8490-- |

8591-- Temporarily bind a collection of names to local variables