git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Improve addTypeClassDictionaries perf
c3b4444Brian McKenna
src/Language/PureScript/TypeChecker.hs+6−10
compare with golang
unifiedsplit
@@ -88,10 +88,9 @@ addTypeClass moduleName pn args implies ds =
88 toPair (PositionedDeclaration _ _ d) = toPair d
88 toPair (PositionedDeclaration _ _ d) = toPair d
89 toPair _ = error "Invalid declaration in TypeClassDeclaration"
89 toPair _ = error "Invalid declaration in TypeClassDeclaration"
90
90
91−addTypeClassDictionaries :: [TypeClassDictionaryInScope] -> Check ()
91+addTypeClassDictionaries :: Maybe ModuleName -> M.Map (Qualified Ident) TypeClassDictionaryInScope -> Check ()
92−addTypeClassDictionaries entries =
92+addTypeClassDictionaries mn 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 } }
93+ modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = M.insertWith M.union mn entries (typeClassDictionaries . checkEnv $ st) } }
95
94
96checkDuplicateTypeArguments :: [String] -> Check ()
95checkDuplicateTypeArguments :: [String] -> Check ()
97checkDuplicateTypeArguments args = for_ firstDup $ \dup ->
96checkDuplicateTypeArguments args = for_ firstDup $ \dup ->
@@ -224,11 +223,7 @@ typeCheckAll mainModuleName moduleName exps = go
224 return $ d : ds
223 return $ d : ds
225 go (d@(ImportDeclaration importedModule _ _) : rest) = do
224 go (d@(ImportDeclaration importedModule _ _) : rest) = do
226 instances <- lookupTypeClassDictionaries $ Just importedModule
225 instances <- lookupTypeClassDictionaries $ Just importedModule
227− addTypeClassDictionaries [ tcd { tcdName = Qualified (Just moduleName) ident, tcdType = TCDAlias (canonicalizeDictionary tcd) }
226+ addTypeClassDictionaries (Just moduleName) instances
228− | tcd <- instances
229− , tcdExported tcd
230− , let (Qualified _ ident) = tcdName tcd
231− ]
232 ds <- go rest
227 ds <- go rest
233 return $ d : ds
228 return $ d : ds
234 go (d@(TypeClassDeclaration pn args implies tys) : rest) = do
229 go (d@(TypeClassDeclaration pn args implies tys) : rest) = do
@@ -247,7 +242,8 @@ typeCheckAll mainModuleName moduleName exps = go
247 goInstance d dictName deps className tys rest = do
242 goInstance d dictName deps className tys rest = do
248 mapM_ (checkTypeClassInstance moduleName) tys
243 mapM_ (checkTypeClassInstance moduleName) tys
249 forM_ deps $ mapM_ (checkTypeClassInstance moduleName) . snd
244 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
251 ds <- go rest
247 ds <- go rest
252 return $ d : ds
248 return $ d : ds
253
249
src/Language/PureScript/TypeChecker/Monad.hs+2−2
@@ -84,8 +84,8 @@ getTypeClassDictionaries = fmap M.elems . typeClassDictionaries . checkEnv <$> g
84-- |
84-- |
85-- Lookup type class dictionaries in a module.
85-- Lookup type class dictionaries in a module.
86--
86--
87−lookupTypeClassDictionaries :: (Functor m, MonadState CheckState m) => Maybe ModuleName -> m [TypeClassDictionaryInScope]
87+lookupTypeClassDictionaries :: (Functor m, MonadState CheckState m) => Maybe ModuleName -> m (M.Map (Qualified Ident) TypeClassDictionaryInScope)
88−lookupTypeClassDictionaries mn = maybe [] M.elems . M.lookup mn . typeClassDictionaries . checkEnv <$> get
88+lookupTypeClassDictionaries mn = fromMaybe M.empty . M.lookup mn . typeClassDictionaries . checkEnv <$> get
89
89
90-- |
90-- |
91-- Temporarily bind a collection of names to local variables
91-- Temporarily bind a collection of names to local variables