9264ef4 · rowtype-yoga/purescript-native

CONTRIBUTORS.md+1

@@ -26,6 +26,7 @@ This file lists the contributors to the PureScript compiler project, and the ter

26- [@joneshf](https://github.com/joneshf) (Hardy Jones) - My existing contributions and all future contributions until further notice are Copyright Hardy Jones, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.

27- [@kRITZCREEK](https://github.com/kRITZCREEK) (Christoph Hegemann) - My existing contributions and all future contributions until further notice are Copyright Christoph Hegemann, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.

28- [@L8D](https://github.com/L8D) (Tenor Biel) My existing contributions and all future contributions until further notice are Copyright Tenor Biel, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

29+- [@leighman](http://github.com/leighman) (Jack Leigh) My existing contributions and all future contributions until further notice are Copyright Jack Leigh, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

29- [@lukerandall](https://github.com/lukerandall) (Luke Randall) My existing contributions and all future contributions until further notice are Copyright Luke Randall, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

30- [@lukerandall](https://github.com/lukerandall) (Luke Randall) My existing contributions and all future contributions until further notice are Copyright Luke Randall, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

30- [@michaelficarra](https://github.com/michaelficarra) (Michael Ficarra) My existing contributions and all future contributions until further notice are Copyright Michael Ficarra, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

31- [@michaelficarra](https://github.com/michaelficarra) (Michael Ficarra) My existing contributions and all future contributions until further notice are Copyright Michael Ficarra, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

31- [@MichaelXavier](https://github.com/MichaelXavier) (Michael Xavier) - My existing contributions and all future contributions until further notice are Copyright Michael Xavier, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.

32- [@MichaelXavier](https://github.com/MichaelXavier) (Michael Xavier) - My existing contributions and all future contributions until further notice are Copyright Michael Xavier, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.

bundle/.gitignore+1

@@ -1,3 +1,4 @@

1build/

2*.tar.gz

3*.sha

4+*.md5

examples/passing/UnicodeIdentifier.pursnew file+5

@@ -0,0 +1,5 @@

1+module Main where

2+

3+f asgård = asgård

4+

5+main = Control.Monad.Eff.Console.log (f "Done")

psci/PSCi.hs+1−1

@@ -242,7 +242,7 @@ createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =

242 P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName (importDecl `map` imports) Nothing

243

244importDecl :: ImportedModule -> P.Declaration

245−importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ

245+importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ False

246

247indexFile :: FilePath

248indexFile = ".psci_modules" ++ pathSeparator : "index.js"

psci/Parser.hs+3−1

@@ -106,7 +106,9 @@ psciLet = Decls <$> (P.reserved "let" *> P.indented *> manyDecls)

106-- | Imports must be handled separately from other declarations, so that

107-- :show import works, for example.

108psciImport :: P.TokenParser Command

109+psciImport = do

109−psciImport = Import <$> P.parseImportDeclaration'

110+ (mn, declType, asQ, _) <- P.parseImportDeclaration'

111+ return $ Import (mn, declType, asQ)

110

112

111-- | Any other declaration that we don't need a 'special case' parser for

113-- | Any other declaration that we don't need a 'special case' parser for

112-- (like let or import declarations).

114-- (like let or import declarations).

src/Language/PureScript/AST/Declarations.hs+2−1

@@ -153,8 +153,9 @@ data Declaration

153 | FixityDeclaration Fixity String

154 -- |

155 -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)

156+ -- TODO: also a boolean specifying whether the old `qualified` syntax was used, so a warning can be raised in desugaring (remove for 0.9)

156 --

157 --

157− | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)

158+ | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName) Bool

158 -- |

159 -- |

159 -- A type class declaration (name, argument, implies, member declarations)

160 -- A type class declaration (name, argument, implies, member declarations)

160 --

161 --

src/Language/PureScript/CoreFn/Desugar.hs+6−2

@@ -203,9 +203,13 @@ moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =

203--

204findQualModules :: [A.Declaration] -> [ModuleName]

205findQualModules decls =

206− let (f, _, _, _, _) = everythingOnValues (++) (const []) fqValues fqBinders (const []) (const [])

206+ let (f, _, _, _, _) = everythingOnValues (++) fqDecls fqValues fqBinders (const []) (const [])

207 in f `concatMap` decls

208 where

209+ fqDecls :: A.Declaration -> [ModuleName]

210+ fqDecls (A.TypeInstanceDeclaration _ _ (Qualified (Just mn) _) _ _) = [mn]

211+ fqDecls _ = []

212+

209 fqValues :: A.Expr -> [ModuleName]

213 fqValues :: A.Expr -> [ModuleName]

210 fqValues (A.Var (Qualified (Just mn) _)) = [mn]

214 fqValues (A.Var (Qualified (Just mn) _)) = [mn]

211 fqValues (A.Constructor (Qualified (Just mn) _)) = [mn]

215 fqValues (A.Constructor (Qualified (Just mn) _)) = [mn]

@@ -219,7 +223,7 @@ findQualModules decls =

219-- Desugars import declarations from AST to CoreFn representation.

223-- Desugars import declarations from AST to CoreFn representation.

220--

224--

221importToCoreFn :: A.Declaration -> Maybe ModuleName

225importToCoreFn :: A.Declaration -> Maybe ModuleName

222−importToCoreFn (A.ImportDeclaration name _ _) = Just name

226+importToCoreFn (A.ImportDeclaration name _ _ _) = Just name

223importToCoreFn (A.PositionedDeclaration _ _ d) = importToCoreFn d

227importToCoreFn (A.PositionedDeclaration _ _ d) = importToCoreFn d

224importToCoreFn _ = Nothing

228importToCoreFn _ = Nothing

225

229

src/Language/PureScript/Docs/ParseAndDesugar.hs+2−2

@@ -108,9 +108,9 @@ fileInfoToString (FromDep _ fn) = fn

108addDefaultImport :: P.ModuleName -> P.Module -> P.Module

109addDefaultImport toImport m@(P.Module ss coms mn decls exps) =

110 if isExistingImport `any` decls || mn == toImport then m

111− else P.Module ss coms mn (P.ImportDeclaration toImport P.Implicit Nothing : decls) exps

111+ else P.Module ss coms mn (P.ImportDeclaration toImport P.Implicit Nothing False : decls) exps

112 where

113− isExistingImport (P.ImportDeclaration mn' _ _) | mn' == toImport = True

113+ isExistingImport (P.ImportDeclaration mn' _ _ _) | mn' == toImport = True

114 isExistingImport (P.PositionedDeclaration _ _ d) = isExistingImport d

115 isExistingImport _ = False

116

src/Language/PureScript/Errors.hs+34−8

@@ -21,8 +21,9 @@ module Language.PureScript.Errors where

21import Prelude ()

22import Prelude.Compat

23

24+import Data.Ord (comparing)

24import Data.Either (lefts, rights)

25import Data.Either (lefts, rights)

25−import Data.List (intercalate, transpose, nub, nubBy)

26+import Data.List (intercalate, transpose, nub, nubBy, sortBy)

26import Data.Function (on)

27import Data.Function (on)

27import Data.Foldable (fold)

28import Data.Foldable (fold)

28

29

@@ -32,7 +33,7 @@ import Control.Monad

32import Control.Monad.Writer

33import Control.Monad.Writer

33import Control.Monad.Error.Class (MonadError(..))

34import Control.Monad.Error.Class (MonadError(..))

34import Control.Monad.Trans.State.Lazy

35import Control.Monad.Trans.State.Lazy

35−import Control.Arrow (first)

36+import Control.Arrow (first, (&&&))

36

37

37import Language.PureScript.Crash

38import Language.PureScript.Crash

38import Language.PureScript.AST

39import Language.PureScript.AST

@@ -141,6 +142,7 @@ data SimpleErrorMessage

141 | UnusedExplicitImport ModuleName [String]

142 | UnusedExplicitImport ModuleName [String]

142 | UnusedDctorImport ProperName

143 | UnusedDctorImport ProperName

143 | UnusedDctorExplicitImport ProperName [ProperName]

144 | UnusedDctorExplicitImport ProperName [ProperName]

145+ | DeprecatedQualifiedSyntax ModuleName ModuleName

144 deriving (Show)

146 deriving (Show)

145

147

146-- | Error message hints, providing more detailed information about failure.

148-- | Error message hints, providing more detailed information about failure.

@@ -275,6 +277,7 @@ errorCode em = case unwrapErrorMessage em of

275 UnusedExplicitImport{} -> "UnusedExplicitImport"

277 UnusedExplicitImport{} -> "UnusedExplicitImport"

276 UnusedDctorImport{} -> "UnusedDctorImport"

278 UnusedDctorImport{} -> "UnusedDctorImport"

277 UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"

279 UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"

280+ DeprecatedQualifiedSyntax{} -> "DeprecatedQualifiedSyntax"

278

281

279

282

280-- |

283-- |

@@ -520,12 +523,31 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

520 <> foldMap (\expr -> [ line "Relevant expression: "

523 <> foldMap (\expr -> [ line "Relevant expression: "

521 , indent $ prettyPrintValue valueDepth expr

524 , indent $ prettyPrintValue valueDepth expr

522 ]) binding

525 ]) binding

523− renderSimpleErrorMessage (TypesDoNotUnify t1 t2)

526+ renderSimpleErrorMessage (TypesDoNotUnify u1 u2)

527+ = let (sorted1, sorted2) = sortRows u1 u2

528+

529+ sortRows :: Type -> Type -> (Type, Type)

530+ sortRows r1@RCons{} r2@RCons{} = sortRows' (rowToList r1) (rowToList r2)

531+ sortRows t1 t2 = (t1, t2)

532+

533+ -- Put the common labels last

534+ sortRows' :: ([(String, Type)], Type) -> ([(String, Type)], Type) -> (Type, Type)

535+ sortRows' (s1, r1) (s2, r2) =

536+ let common :: [(String, (Type, Type))]

537+ common = sortBy (comparing fst) $ [ (name, (t1, t2)) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

538+

539+ sd1, sd2 :: [(String, Type)]

540+ sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

541+ sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

542+ in ( rowFromList (sortBy (comparing fst) sd1 ++ map (fst &&& fst . snd) common, r1)

543+ , rowFromList (sortBy (comparing fst) sd2 ++ map (fst &&& snd . snd) common, r2)

544+ )

524− = paras [ line "Could not match type"

545+ in paras [ line "Could not match type"

525− , indent $ typeAsBox t1

546+ , indent $ typeAsBox sorted1

526− , line "with type"

547+ , line "with type"

527− , indent $ typeAsBox t2

548+ , indent $ typeAsBox sorted2

528− ]

549+ ]

550+

529 renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =

551 renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =

530 paras [ line "Could not match kind"

552 paras [ line "Could not match kind"

531 , indent $ line $ prettyPrintKind k1

553 , indent $ line $ prettyPrintKind k1

@@ -692,6 +714,10 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

692 paras [ line $ "The import of type " ++ runProperName name ++ " includes the following unused data constructors:"

714 paras [ line $ "The import of type " ++ runProperName name ++ " includes the following unused data constructors:"

693 , indent $ paras $ map (line .runProperName) names ]

715 , indent $ paras $ map (line .runProperName) names ]

694

716

717+ renderSimpleErrorMessage (DeprecatedQualifiedSyntax name qualName) =

718+ paras [ line $ "The import of type " ++ runModuleName name ++ " as " ++ runModuleName qualName ++ " uses the deprecated 'import qualified' syntax."

719+ , line $ "This syntax form will be removed in PureScript 0.9." ]

720+

695 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

721 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

696 renderHint (ErrorUnifyingTypes t1 t2) detail =

722 renderHint (ErrorUnifyingTypes t1 t2) detail =

697 paras [ detail

723 paras [ detail

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

@@ -173,7 +173,7 @@ moduleToExternsFile (Module _ _ mn ds (Just exps)) env = ExternsFile{..}

173 fixityDecl _ = Nothing

174

175 importDecl :: Declaration -> Maybe ExternsImport

176− importDecl (ImportDeclaration m mt qmn) = Just (ExternsImport m mt qmn)

176+ importDecl (ImportDeclaration m mt qmn _) = Just (ExternsImport m mt qmn)

177 importDecl (PositionedDeclaration _ _ d) = importDecl d

178 importDecl _ = Nothing

179

src/Language/PureScript/Make.hs+14−12

@@ -63,6 +63,7 @@ import Data.Traversable (for)

63import Data.Version (showVersion)

64import Data.Aeson (encode, decode)

65import qualified Data.ByteString.Lazy as B

66+import qualified Data.ByteString.UTF8 as BU8

66import qualified Data.Set as S

67import qualified Data.Set as S

67import qualified Data.Map as M

68import qualified Data.Map as M

68

69

@@ -70,6 +71,7 @@ import System.Directory

70 (doesFileExist, getModificationTime, createDirectoryIfMissing)

71 (doesFileExist, getModificationTime, createDirectoryIfMissing)

71import System.FilePath ((</>), takeDirectory)

72import System.FilePath ((</>), takeDirectory)

72import System.IO.Error (tryIOError)

73import System.IO.Error (tryIOError)

74+import System.IO.UTF8 (readUTF8File, writeUTF8File)

73

75

74import Language.PureScript.Crash

76import Language.PureScript.Crash

75import Language.PureScript.AST

77import Language.PureScript.AST

@@ -123,7 +125,7 @@ data MakeActions m = MakeActions {

123 -- |

125 -- |

124 -- Read the externs file for a module as a string and also return the actual

126 -- Read the externs file for a module as a string and also return the actual

125 -- path for the file.

127 -- path for the file.

126− , readExterns :: ModuleName -> m (FilePath, B.ByteString)

128+ , readExterns :: ModuleName -> m (FilePath, Externs)

127 -- |

129 -- |

128 -- Run the code generator for the module and write any required output files.

130 -- Run the code generator for the module and write any required output files.

129 --

131 --

@@ -137,7 +139,7 @@ data MakeActions m = MakeActions {

137-- |

139-- |

138-- Generated code for an externs file.

140-- Generated code for an externs file.

139--

141--

140−type Externs = B.ByteString

142+type Externs = String

141

143

142-- |

144-- |

143-- Determines when to rebuild a module

145-- Determines when to rebuild a module

@@ -231,7 +233,7 @@ make MakeActions{..} ms = do

231 corefn = CF.moduleToCoreFn env' mod'

233 corefn = CF.moduleToCoreFn env' mod'

232 [renamed] = renameInModules [corefn]

234 [renamed] = renameInModules [corefn]

233 exts = moduleToExternsFile mod' env'

235 exts = moduleToExternsFile mod' env'

234− evalSupplyT nextVar $ codegen renamed env' $ encode exts

236+ evalSupplyT nextVar . codegen renamed env' . BU8.toString . B.toStrict . encode $ exts

235 return exts

237 return exts

236 markComplete (Just (warnings, exts)) Nothing

238 markComplete (Just (warnings, exts)) Nothing

237

239

@@ -258,9 +260,9 @@ make MakeActions{..} ms = do

258 shouldExist (Just t) = t

260 shouldExist (Just t) = t

259 shouldExist _ = internalError "make: dependency should already have been built."

261 shouldExist _ = internalError "make: dependency should already have been built."

260

262

261− decodeExterns :: B.ByteString -> Maybe ExternsFile

263+ decodeExterns :: Externs -> Maybe ExternsFile

262 decodeExterns bs = do

264 decodeExterns bs = do

263− externs <- decode bs

265+ externs <- decode (fromString bs)

264 guard $ efVersion externs == showVersion Paths.version

266 guard $ efVersion externs == showVersion Paths.version

265 return externs

267 return externs

266

268

@@ -270,9 +272,9 @@ make MakeActions{..} ms = do

270addDefaultImport :: ModuleName -> Module -> Module

272addDefaultImport :: ModuleName -> Module -> Module

271addDefaultImport toImport m@(Module ss coms mn decls exps) =

273addDefaultImport toImport m@(Module ss coms mn decls exps) =

272 if isExistingImport `any` decls || mn == toImport then m

274 if isExistingImport `any` decls || mn == toImport then m

273− else Module ss coms mn (ImportDeclaration toImport Implicit Nothing : decls) exps

275+ else Module ss coms mn (ImportDeclaration toImport Implicit Nothing False : decls) exps

274 where

276 where

275− isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True

277+ isExistingImport (ImportDeclaration mn' _ _ _) | mn' == toImport = True

276 isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

278 isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

277 isExistingImport _ = False

279 isExistingImport _ = False

278

280

@@ -335,7 +337,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

335 externsFile = outputDir </> filePath </> "externs.json"

337 externsFile = outputDir </> filePath </> "externs.json"

336 min <$> getTimestamp jsFile <*> getTimestamp externsFile

338 min <$> getTimestamp jsFile <*> getTimestamp externsFile

337

339

338− readExterns :: ModuleName -> Make (FilePath, B.ByteString)

340+ readExterns :: ModuleName -> Make (FilePath, Externs)

339 readExterns mn = do

341 readExterns mn = do

340 let path = outputDir </> runModuleName mn </> "externs.json"

342 let path = outputDir </> runModuleName mn </> "externs.json"

341 (path, ) <$> readTextFile path

343 (path, ) <$> readTextFile path

@@ -371,13 +373,13 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

371 exists <- doesFileExist path

373 exists <- doesFileExist path

372 traverse (const $ getModificationTime path) $ guard exists

374 traverse (const $ getModificationTime path) $ guard exists

373

375

374− readTextFile :: FilePath -> Make B.ByteString

376+ readTextFile :: FilePath -> Make String

375− readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ B.readFile path

377+ readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ readUTF8File path

376

378

377− writeTextFile :: FilePath -> B.ByteString -> Make ()

379+ writeTextFile :: FilePath -> String -> Make ()

378 writeTextFile path text = makeIO (const (ErrorMessage [] $ CannotWriteFile path)) $ do

380 writeTextFile path text = makeIO (const (ErrorMessage [] $ CannotWriteFile path)) $ do

379 mkdirp path

381 mkdirp path

380− B.writeFile path text

382+ writeUTF8File path text

381 where

383 where

382 mkdirp :: FilePath -> IO ()

384 mkdirp :: FilePath -> IO ()

383 mkdirp = createDirectoryIfMissing True . takeDirectory

385 mkdirp = createDirectoryIfMissing True . takeDirectory

src/Language/PureScript/ModuleDependencies.hs+1−1

@@ -57,7 +57,7 @@ usedModules :: Declaration -> [ModuleName]

57usedModules = let (f, _, _, _, _) = everythingOnValues (++) forDecls forValues (const []) (const []) (const []) in nub . f

58 where

59 forDecls :: Declaration -> [ModuleName]

60− forDecls (ImportDeclaration mn _ _) = [mn]

60+ forDecls (ImportDeclaration mn _ _ _) = [mn]

61 forDecls _ = []

62

63 forValues :: Expr -> [ModuleName]

src/Language/PureScript/Parser/Declarations.hs+7−14

@@ -141,10 +141,10 @@ parseFixityDeclaration = do

141

142parseImportDeclaration :: TokenParser Declaration

143parseImportDeclaration = do

144− (mn, declType, asQ) <- parseImportDeclaration'

144+ (mn, declType, asQ, isOldSyntax) <- parseImportDeclaration'

145− return $ ImportDeclaration mn declType asQ

145+ return $ ImportDeclaration mn declType asQ isOldSyntax

146

147−parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, Maybe ModuleName)

147+parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, Maybe ModuleName, Bool)

148parseImportDeclaration' = do

149 reserved "import"

150 indented

@@ -152,16 +152,9 @@ parseImportDeclaration' = do

152 where

153 stdImport = do

154 moduleName' <- moduleName

155− suffixHiding moduleName' <|> suffixQualifyingList moduleName'

156− where

157− suffixHiding mn = do

158− reserved "hiding"

159− declType <- qualifyingList Hiding

160− return (mn, declType, Nothing)

161− suffixQualifyingList mn = do

162− declType <- qualifyingList Explicit

155+ declType <- reserved "hiding" *> qualifyingList Hiding <|> qualifyingList Explicit

163− qName <- P.optionMaybe qualifiedName

156+ qName <- P.optionMaybe qualifiedName

164− return (mn, declType, qName)

157+ return (moduleName', declType, qName, False)

165 qualifiedName = reserved "as" *> moduleName

158 qualifiedName = reserved "as" *> moduleName

166 qualImport = do

159 qualImport = do

167 reserved "qualified"

160 reserved "qualified"

@@ -169,7 +162,7 @@ parseImportDeclaration' = do

169 moduleName' <- moduleName

162 moduleName' <- moduleName

170 declType <- qualifyingList Explicit

163 declType <- qualifyingList Explicit

171 qName <- qualifiedName

164 qName <- qualifiedName

172− return (moduleName', declType, Just qName)

165+ return (moduleName', declType, Just qName, True)

173 qualifyingList expectedType = do

166 qualifyingList expectedType = do

174 idents <- P.optionMaybe $ indented *> parens (commaSep parseDeclarationRef)

167 idents <- P.optionMaybe $ indented *> parens (commaSep parseDeclarationRef)

175 return $ fromMaybe Implicit (expectedType <$> idents)

168 return $ fromMaybe Implicit (expectedType <$> idents)

src/Language/PureScript/Pretty/Types.hs+1−1

@@ -79,7 +79,7 @@ prettyPrintRowWith open close = uncurry listToBox . toList []

79

80 toList :: [(String, Type)] -> Type -> ([(String, Type)], Type)

81 toList tys (RCons name ty row) = toList ((name, ty):tys) row

82− toList tys r = (tys, r)

82+ toList tys r = (reverse tys, r)

83

84prettyPrintRow :: Type -> String

85prettyPrintRow = render . prettyPrintRowWith '(' ')'

src/Language/PureScript/Sugar/Names.hs+1−1

@@ -142,7 +142,7 @@ elaborateImports imps (Module ss coms mn decls exps) = Module ss coms mn decls'

142 fqValues (Var (Qualified (Just mn') _)) | mn' `notElem` importedModules imps = [mn']

143 fqValues _ = []

144 mkImport :: ModuleName -> Declaration

145− mkImport mn' = ImportDeclaration mn' (Explicit []) Nothing

145+ mkImport mn' = ImportDeclaration mn' (Explicit []) Nothing False

146

147-- |

148-- Replaces all local names with qualified names within a module and checks that all existing

src/Language/PureScript/Sugar/Names/Exports.hs+1−1

@@ -141,7 +141,7 @@ resolveExports env mn imps exps refs =

141 go (Qualified (Just mn'') name) = fromMaybe (internalError "Missing value in resolveTypeExports") $ do

142 exps' <- envModuleExports <$> mn'' `M.lookup` env

143 ((_, dctors'), mnOrig) <- find (\((name', _), _) -> name == name') (exportedTypes exps')

144− let relevantDctors = mapMaybe (\(Qualified mn''' dctor) -> if mn''' == Just mnOrig then Just dctor else Nothing) dctors

144+ let relevantDctors = mapMaybe (\(Qualified mn''' dctor) -> if mn''' == Just mn'' then Just dctor else Nothing) dctors

145 return ((name, intersect relevantDctors dctors'), mnOrig)

146 go (Qualified Nothing _) = internalError "Unqualified value in resolveTypeExports"

147

src/Language/PureScript/Sugar/Names/Imports.hs+3−2

@@ -25,7 +25,7 @@ import Prelude ()

25import Prelude.Compat

26

27import Data.List (find)

28−import Data.Maybe (fromMaybe, isNothing)

28+import Data.Maybe (fromMaybe, isNothing, fromJust)

29import Data.Foldable (traverse_)

30

31import Control.Arrow (first)

@@ -48,7 +48,8 @@ import Language.PureScript.Sugar.Names.Env

48findImports :: forall m. (Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => [Declaration] -> m (M.Map ModuleName [(Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)])

49findImports = foldM (go Nothing) M.empty

50 where

51− go pos result (ImportDeclaration mn typ qual) = do

51+ go pos result (ImportDeclaration mn typ qual isOldSyntax) = do

52+ when isOldSyntax . tell . errorMessage $ DeprecatedQualifiedSyntax mn (fromJust qual)

52 checkImportRefType typ

53 checkImportRefType typ

53 let imp = (pos, typ, qual)

54 let imp = (pos, typ, qual)

54 return $ M.insert mn (maybe [imp] (imp :) (mn `M.lookup` result)) result

55 return $ M.insert mn (maybe [imp] (imp :) (mn `M.lookup` result)) result

src/Language/PureScript/TypeChecker/Types.hs+1−2

@@ -213,8 +213,7 @@ instantiatePolyTypeWithUnknowns val (ForAll ident ty _) = do

213 instantiatePolyTypeWithUnknowns val ty'

214instantiatePolyTypeWithUnknowns val (ConstrainedType constraints ty) = do

215 dicts <- getTypeClassDictionaries

216− (_, ty') <- instantiatePolyTypeWithUnknowns (internalError "Types under a constraint cannot themselves be constrained") ty

217− return (foldl App val (map (flip TypeClassDictionary dicts) constraints), ty')

216+ instantiatePolyTypeWithUnknowns (foldl App val (map (flip TypeClassDictionary dicts) constraints)) ty

218instantiatePolyTypeWithUnknowns val ty = return (val, ty)

217instantiatePolyTypeWithUnknowns val ty = return (val, ty)

219

218

220-- | Infer a type for a value, rethrowing any error to provide a more useful error message

219-- | Infer a type for a value, rethrowing any error to provide a more useful error message

src/Language/PureScript/TypeChecker/Unify.hs+1−1

@@ -163,7 +163,7 @@ unifyRows r1 r2 =

163 unifyRows' [] REmpty [] REmpty = return ()

164 unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return ()

165 unifyRows' [] (Skolem _ s1 _) [] (Skolem _ s2 _) | s1 == s2 = return ()

166− unifyRows' sd3 r3 sd4 r4 = throwError . errorMessage $ TypesDoNotUnify (rowFromList (sd3, r3)) (rowFromList (sd4, r4))

166+ unifyRows' _ _ _ _ = throwError . errorMessage $ TypesDoNotUnify r1 r2

167

168-- |

169-- Check that two types unify

src/System/IO/UTF8.hs+20−4

@@ -1,9 +1,25 @@

1module System.IO.UTF8

2+

2where

3where

3−import System.IO (hGetContents, hSetEncoding, openFile, utf8, IOMode (..))

4+

5+import System.IO ( IOMode(..)

6+ , hGetContents

7+ , hSetEncoding

8+ , hClose

9+ , hPutStr

10+ , openFile

11+ , utf8

12+ )

4

13

5readUTF8File :: FilePath -> IO String

14readUTF8File :: FilePath -> IO String

6readUTF8File inFile = do

15readUTF8File inFile = do

7− h <- openFile inFile ReadMode

16+ h <- openFile inFile ReadMode

8− hSetEncoding h utf8

17+ hSetEncoding h utf8

9− hGetContents h

18+ hGetContents h

19+

20+writeUTF8File :: FilePath -> String -> IO ()

21+writeUTF8File inFile text = do

22+ h <- openFile inFile WriteMode

23+ hSetEncoding h utf8

24+ hPutStr h text

25+ hClose h