git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Remove poor performing entails.filterModule
40ad1cfBrian McKenna
src/Language/PureScript/AST/Declarations.hs+2−1
compare with golang
unifiedsplit
@@ -17,6 +17,7 @@
17module Language.PureScript.AST.Declarations where
17module Language.PureScript.AST.Declarations where
18
18
19import qualified Data.Data as D
19import qualified Data.Data as D
20+import qualified Data.Map as M
20
21
21import Language.PureScript.AST.Binders
22import Language.PureScript.AST.Binders
22import Language.PureScript.AST.Operators
23import Language.PureScript.AST.Operators
@@ -360,7 +361,7 @@ data Expr
360 -- at superclass implementations when searching for a dictionary, the type class name and
361 -- at superclass implementations when searching for a dictionary, the type class name and
361 -- instance type, and the type class dictionaries in scope.
362 -- instance type, and the type class dictionaries in scope.
362 --
363 --
363− | TypeClassDictionary Bool Constraint [TypeClassDictionaryInScope]
364+ | TypeClassDictionary Bool Constraint (M.Map (Maybe ModuleName) [TypeClassDictionaryInScope])
364 -- |
365 -- |
365 -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
366 -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
366 --
367 --
src/Language/PureScript/TypeChecker/Entailment.hs+8−8
@@ -21,7 +21,7 @@ module Language.PureScript.TypeChecker.Entailment (
21
21
22import Data.Function (on)
22import Data.Function (on)
23import Data.List
23import Data.List
24−import Data.Maybe (maybeToList)
24+import Data.Maybe (fromMaybe, maybeToList)
25import Data.Foldable (foldMap)
25import Data.Foldable (foldMap)
26import qualified Data.Map as M
26import qualified Data.Map as M
27
27
@@ -47,17 +47,17 @@ newtype Work = Work Integer deriving (Show, Eq, Ord, Num)
47-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
47-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,
48-- return a type class dictionary reference.
48-- return a type class dictionary reference.
49--
49--
50−entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr
50+entails :: Environment -> ModuleName -> M.Map (Maybe ModuleName) [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr
51−entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filter filterModule context))
51+entails env moduleName context = solve (sortedNubBy canonicalizeDictionary dictsInScope)
52 where
52 where
53 sortedNubBy :: (Ord k) => (v -> k) -> [v] -> [v]
53 sortedNubBy :: (Ord k) => (v -> k) -> [v] -> [v]
54 sortedNubBy f vs = M.elems (M.fromList (map (f &&& id) vs))
54 sortedNubBy f vs = M.elems (M.fromList (map (f &&& id) vs))
55
55
56− -- Filter out type dictionaries which are in scope in the current module
57− filterModule :: TypeClassDictionaryInScope -> Bool
56+ dictsInScope :: [TypeClassDictionaryInScope]
58− filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True
57+ dictsInScope = findDicts Nothing ++ findDicts (Just moduleName)
59− filterModule (TypeClassDictionaryInScope { tcdName = Qualified Nothing _ }) = True
58+
60− filterModule _ = False
59+ findDicts :: Maybe ModuleName -> [TypeClassDictionaryInScope]
60+ findDicts = fromMaybe [] . flip M.lookup context
61
61
62 solve :: [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr
62 solve :: [TypeClassDictionaryInScope] -> Constraint -> Bool -> Check Expr
63 solve context' (className, tys) trySuperclasses = do
63 solve context' (className, tys) trySuperclasses = do
src/Language/PureScript/TypeChecker/Monad.hs+3−3
@@ -76,10 +76,10 @@ withTypeClassDictionaries entries action = do
76 return a
76 return a
77
77
78-- |
78-- |
79−-- Get the currently available list of type class dictionaries
79+-- Get the currently available map of type class dictionaries
80--
80--
81−getTypeClassDictionaries :: (Functor m, MonadState CheckState m) => m [TypeClassDictionaryInScope]
81+getTypeClassDictionaries :: (Functor m, MonadState CheckState m) => m (M.Map (Maybe ModuleName) [TypeClassDictionaryInScope])
82−getTypeClassDictionaries = (>>= M.elems) . M.elems . typeClassDictionaries . checkEnv <$> get
82+getTypeClassDictionaries = fmap M.elems . typeClassDictionaries . checkEnv <$> get
83
83
84-- |
84-- |
85-- Lookup type class dictionaries in a module.
85-- Lookup type class dictionaries in a module.