b3741cd · rowtype-yoga/purescript-native

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

compare with golang

unifiedsplit

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

85

86 exportToPs (TypeInstanceRef ident) = do

87 let TypeClassDictionaryInScope { tcdClassName = className, tcdInstanceTypes = tys, tcdDependencies = deps} =

88− fromMaybe (error $ "Type class instance has no dictionary in exportToPs") . find ((== Qualified (Just moduleName) ident) . tcdName) $ typeClassDictionaries env

88+ fromMaybe (error $ "Type class instance has no dictionary in exportToPs") . find ((== Qualified (Just moduleName) ident) . tcdName) $ M.elems $ typeClassDictionaries env

89 let constraintsText = case fromMaybe [] deps of

90 [] -> ""

91 cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom tys')) cs) ++ ") => "

src/Language/PureScript/Environment.hs+2−2

@@ -49,7 +49,7 @@ data Environment = Environment {

49 -- |

50 -- Available type class dictionaries

51 --

52− , typeClassDictionaries :: [TypeClassDictionaryInScope]

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

53 -- |

54 -- Type classes

55 --

@@ -60,7 +60,7 @@ data Environment = Environment {

60-- The initial environment with no values and only the default javascript types defined

61--

62initEnvironment :: Environment

63−initEnvironment = Environment M.empty primTypes M.empty M.empty [] M.empty

63+initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty M.empty

64

65-- |

66-- The type of a foreign import

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

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

84

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

86addTypeClassDictionaries entries =

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

87− modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = entries ++ (typeClassDictionaries . checkEnv $ st) } }

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

88

89

89checkTypeClassInstance :: ModuleName -> Type -> Check ()

90checkTypeClassInstance :: ModuleName -> Type -> Check ()

90checkTypeClassInstance _ (TypeVar _) = return ()

91checkTypeClassInstance _ (TypeVar _) = return ()

@@ -182,8 +183,8 @@ typeCheckAll mainModuleName moduleName (d@(FixityDeclaration _ name) : rest) = d

182 guardWith (strMsg ("Fixity declaration with no binding: " ++ name)) $ M.member (moduleName, Op name) $ names env

183 guardWith (strMsg ("Fixity declaration with no binding: " ++ name)) $ M.member (moduleName, Op name) $ names env

183 return $ d : ds

184 return $ d : ds

184typeCheckAll mainModuleName currentModule (d@(ImportDeclaration moduleName _ _) : rest) = do

185typeCheckAll mainModuleName currentModule (d@(ImportDeclaration moduleName _ _) : rest) = do

185− env <- getEnv

186+ tcds <- getTypeClassDictionaries

186− let instances = filter (\tcd -> let Qualified (Just mn) _ = tcdName tcd in moduleName == mn) (typeClassDictionaries env)

187+ let instances = filter (\tcd -> let Qualified (Just mn) _ = tcdName tcd in moduleName == mn) tcds

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

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

188 | tcd <- instances

189 | tcd <- instances

189 , let (Qualified _ ident) = tcdName tcd

190 , let (Qualified _ ident) = tcdName tcd

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

@@ -21,6 +21,7 @@ module Language.PureScript.TypeChecker.Monad where

21import Language.PureScript.Types

22import Language.PureScript.Kinds

23import Language.PureScript.Names

24+import Language.PureScript.Declarations (canonicalizeDictionary)

24import Language.PureScript.Environment

25import Language.PureScript.Environment

25import Language.PureScript.TypeClassDictionaries

26import Language.PureScript.TypeClassDictionaries

26import Language.PureScript.Options

27import Language.PureScript.Options

@@ -63,7 +64,8 @@ bindTypes newNames action = do

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

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

64withTypeClassDictionaries entries action = do

65withTypeClassDictionaries entries action = do

65 orig <- get

66 orig <- get

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

66− modify $ \st -> st { checkEnv = (checkEnv st) { typeClassDictionaries = entries ++ (typeClassDictionaries . checkEnv $ st) } }

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

67 a <- action

69 a <- action

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

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

69 return a

71 return a

@@ -72,7 +74,7 @@ withTypeClassDictionaries entries action = do

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

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

73--

75--

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

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

75−getTypeClassDictionaries = typeClassDictionaries . checkEnv <$> get

77+getTypeClassDictionaries = M.elems . typeClassDictionaries . checkEnv <$> get

76

78

77-- |

79-- |

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

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