c3b4444 · rowtype-yoga/purescript-native

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

Improve addTypeClassDictionaries perf

We already have maps indexed by the right keys, we just need to union them to the new module. Criterion benchmark including the previous patch: benchmarking unpatched time 20.60 s (20.26 s .. 21.37 s) 1.000 R² (NaN R² .. 1.000 R²) mean 19.93 s (19.79 s .. 20.01 s) std dev 123.3 ms (0.0 s .. 136.6 ms) variance introduced by outliers: 19% (moderately inflated) benchmarking patched time 13.90 s (10.16 s .. 15.90 s) 0.991 R² (0.981 R² .. 1.000 R²) mean 13.31 s (12.50 s .. 13.82 s) std dev 766.5 ms (0.0 s .. 880.3 ms) variance introduced by outliers: 19% (moderately inflated)

commitc3b4444a3b34426a47b84314e81eee718d7bb98d authorBrian McKenna <brian@brianmckenna.org> dateTue 16 Jun 2015, 11:06 (11 years ago) parenta926238

2 files changed+8−12

compare with golang

unifiedsplit

src/Language/PureScript/TypeChecker.hs+6−10 src/Language/PureScript/TypeChecker/Monad.hs+2−2

src/Language/PureScript/TypeChecker.hs+6−10

@@ -88,10 +88,9 @@ addTypeClass moduleName pn args implies ds =

8888 toPair (PositionedDeclaration _ _ d) = toPair d

8989 toPair _ = error "Invalid declaration in TypeClassDeclaration"

9090

91−addTypeClassDictionaries :: [TypeClassDictionaryInScope] -> Check ()

92−addTypeClassDictionaries entries =

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 } }

91+addTypeClassDictionaries :: Maybe ModuleName -> M.Map (Qualified Ident) TypeClassDictionaryInScope -> Check ()

92+addTypeClassDictionaries mn entries =

93+ modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = M.insertWith M.union mn entries (typeClassDictionaries . checkEnv $ st) } }

9594

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

9796checkDuplicateTypeArguments args = for_ firstDup $ \dup ->

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

224223 return $ d : ds

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

226225 instances <- lookupTypeClassDictionaries $ Just importedModule

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

228− | tcd <- instances

229− , tcdExported tcd

230− , let (Qualified _ ident) = tcdName tcd

231− ]

226+ addTypeClassDictionaries (Just moduleName) instances

232227 ds <- go rest

233228 return $ d : ds

234229 go (d@(TypeClassDeclaration pn args implies tys) : rest) = do

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

247242 goInstance d dictName deps className tys rest = do

248243 mapM_ (checkTypeClassInstance moduleName) tys

249244 forM_ deps $ mapM_ (checkTypeClassInstance moduleName) . snd

250− addTypeClassDictionaries [TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className tys (Just deps) TCDRegular isInstanceExported]

245+ let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className tys (Just deps) TCDRegular isInstanceExported

246+ addTypeClassDictionaries (Just moduleName) $ M.singleton (canonicalizeDictionary dict) dict

251247 ds <- go rest

252248 return $ d : ds

253249

src/Language/PureScript/TypeChecker/Monad.hs+2−2

@@ -84,8 +84,8 @@ getTypeClassDictionaries = fmap M.elems . typeClassDictionaries . checkEnv <$> g

8484-- |

8585-- Lookup type class dictionaries in a module.

8686--

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

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

87+lookupTypeClassDictionaries :: (Functor m, MonadState CheckState m) => Maybe ModuleName -> m (M.Map (Qualified Ident) TypeClassDictionaryInScope)

88+lookupTypeClassDictionaries mn = fromMaybe M.empty . M.lookup mn . typeClassDictionaries . checkEnv <$> get

8989

9090-- |

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