git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1161 from puffnfresh/perf/entails-filtermodule

Remove poor performing entails.filterModule

commit2021aa012f177fd8da4969cf819af16b3552e5c5 authorPhil Freeman <paf31@cantab.net> dateThu 11 Jun 2015, 14:06 (11 years ago) parentc4b2e4140ad1cf
3 files changed+13−12
compare with golang
unifiedsplit
src/Language/PureScript/AST/Declarations.hs+2−1 src/Language/PureScript/TypeChecker/Entailment.hs+8−8 src/Language/PureScript/TypeChecker/Monad.hs+3−3
src/Language/PureScript/AST/Declarations.hs+2−1
@@ -17,6 +17,7 @@
1717module Language.PureScript.AST.Declarations where
1818
1919import qualified Data.Data as D
20+import qualified Data.Map as M
2021
2122import Language.PureScript.AST.Binders
2223import Language.PureScript.AST.Operators
@@ -360,7 +361,7 @@ data Expr
360361 -- at superclass implementations when searching for a dictionary, the type class name and
361362 -- instance type, and the type class dictionaries in scope.
362363 --
363− | TypeClassDictionary Bool Constraint [TypeClassDictionaryInScope]
364+ | TypeClassDictionary Bool Constraint (M.Map (Maybe ModuleName) [TypeClassDictionaryInScope])
364365 -- |
365366 -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
366367 --
src/Language/PureScript/TypeChecker/Entailment.hs+8−8
@@ -21,7 +21,7 @@ module Language.PureScript.TypeChecker.Entailment (
2121
2222import Data.Function (on)
2323import Data.List
24−import Data.Maybe (maybeToList)
24+import Data.Maybe (fromMaybe, maybeToList)
2525import Data.Foldable (foldMap)
2626import qualified Data.Map as M
2727
@@ -47,17 +47,17 @@ newtype Work = Work Integer deriving (Show, Eq, Ord, Num)
4747-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
4848-- return a type class dictionary reference.
4949--
50−entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr
51−entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filter filterModule context))
50+entails :: Environment -> ModuleName -> M.Map (Maybe ModuleName) [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr
51+entails env moduleName context = solve (sortedNubBy canonicalizeDictionary dictsInScope)
5252 where
5353 sortedNubBy :: (Ord k) => (v -> k) -> [v] -> [v]
5454 sortedNubBy f vs = M.elems (M.fromList (map (f &&& id) vs))
5555
56− -- Filter out type dictionaries which are in scope in the current module
57− filterModule :: TypeClassDictionaryInScope -> Bool
58− filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True
59− filterModule (TypeClassDictionaryInScope { tcdName = Qualified Nothing _ }) = True
60− filterModule _ = False
56+ dictsInScope :: [TypeClassDictionaryInScope]
57+ dictsInScope = findDicts Nothing ++ findDicts (Just moduleName)
58+
59+ findDicts :: Maybe ModuleName -> [TypeClassDictionaryInScope]
60+ findDicts = fromMaybe [] . flip M.lookup context
6161
6262 solve :: [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr
6363 solve context' (className, tys) trySuperclasses = do
src/Language/PureScript/TypeChecker/Monad.hs+3−3
@@ -76,10 +76,10 @@ withTypeClassDictionaries entries action = do
7676 return a
7777
7878-- |
79−-- Get the currently available list of type class dictionaries
79+-- Get the currently available map of type class dictionaries
8080--
81−getTypeClassDictionaries :: (Functor m, MonadState CheckState m) => m [TypeClassDictionaryInScope]
82−getTypeClassDictionaries = (>>= M.elems) . M.elems . typeClassDictionaries . checkEnv <$> get
81+getTypeClassDictionaries :: (Functor m, MonadState CheckState m) => m (M.Map (Maybe ModuleName) [TypeClassDictionaryInScope])
82+getTypeClassDictionaries = fmap M.elems . typeClassDictionaries . checkEnv <$> get
8383
8484-- |
8585-- Lookup type class dictionaries in a module.