eb1018c · rowtype-yoga/purescript-native

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

compare with golang

unifiedsplit

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

107

108 exportToPs (TypeInstanceRef ident) = do

109 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

111 let constraintsText = case fromMaybe [] deps of

112 [] -> ""

113 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 {

49 -- |

50 -- Available type class dictionaries

51 --

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

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

53 -- |

54 -- Type classes

55 --

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

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

90

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

92addTypeClassDictionaries entries =

93− let mentries = M.fromList [ ((canonicalizeDictionary entry, mn), entry) | entry@TypeClassDictionaryInScope{ tcdName = Qualified 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 = (typeClassDictionaries . checkEnv $ st) `M.union` mentries } }

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

95

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

97checkDuplicateTypeArguments args = for_ firstDup $ \dup ->

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

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

224 return $ d : ds

225 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

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

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

229 | tcd <- instances

228 | tcd <- instances

230 , tcdExported tcd

229 , tcdExported tcd

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

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

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

70withTypeClassDictionaries entries action = do

71 orig <- get

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

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 = (typeClassDictionaries . checkEnv $ st) `M.union` mentries } }

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

74 a <- action

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

76 return a

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

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

80--

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

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]

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

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

83

89

84-- |

90-- |

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

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