9b73cef · rowtype-yoga/purescript-native

hierarchy/Main.hs+1−1

compare with golang

unifiedsplit

@@ -64,7 +64,7 @@ compile (HierarchyOptions input mOutput) = do

64 case modules of

65 Left err -> hPutStr stderr (show err) >> exitFailure

66 Right ms -> do

67− for_ ms $ \(P.Module moduleName decls _) ->

67+ for_ ms $ \(P.Module _ moduleName decls _) ->

68 let name = runModuleName moduleName

69 tcs = filter P.isTypeClassDeclaration decls

70 supers = sort . nub . filter (not . null) $ fmap superClasses tcs

psc-docs/Main.hs+3−1

@@ -86,9 +86,11 @@ renderModules ms = do

86 mapM_ renderModule ms

87

88renderModule :: P.Module -> Docs

89−renderModule mdl@(P.Module moduleName _ exps) = do

89+renderModule mdl@(P.Module coms moduleName _ exps) = do

90 headerLevel 2 $ "Module " ++ P.runModuleName moduleName

91 spacer

92+ renderComments coms

93+ spacer

92 renderTopLevel exps (P.exportedDeclarations mdl)

94 renderTopLevel exps (P.exportedDeclarations mdl)

93 spacer

95 spacer

94

96

psci/Main.hs+7−7

@@ -286,7 +286,7 @@ completion = completeWordWithPrev Nothing " \t\n\r" findCompletions

286 getTypeName _ = Nothing

287

288 identNames :: P.Module -> [N.Ident]

289− identNames (P.Module _ ds exports) = nub [ ident | ident <- mapMaybe (getDeclName exports) (D.flattenDecls ds) ]

289+ identNames (P.Module _ _ ds exports) = nub [ ident | ident <- mapMaybe (getDeclName exports) (D.flattenDecls ds) ]

290 where getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident

291 getDeclName exts decl@(P.ValueDeclaration ident _ _ _) | P.isExported exts decl = Just ident

292 getDeclName exts decl@(P.ExternDeclaration _ ident _ _) | P.isExported exts decl = Just ident

@@ -307,7 +307,7 @@ completion = completeWordWithPrev Nothing " \t\n\r" findCompletions

307 onlyDataDecls = (filter P.isDataDecl (P.exportedDeclarations m))

308

309 moduleNames :: [P.Module] -> [String]

310− moduleNames ms = nub [show moduleName | P.Module moduleName _ _ <- ms]

310+ moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]

311

312 sorter :: Completion -> Completion -> Ordering

313 sorter (Completion _ d1 _) (Completion _ d2 _) = if ":" `isPrefixOf` d1 then LT else compare d1 d2

@@ -364,7 +364,7 @@ createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetB

364 mainDecl = P.ValueDeclaration (P.Ident "main") P.Value [] $ Right mainValue

365 decls = if exec then [itDecl, mainDecl] else [itDecl]

366 in

367− P.Module moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing

367+ P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing

368

369

370-- |

@@ -377,7 +377,7 @@ createTemporaryModuleForKind PSCiState{psciImportedModuleNames = imports} typ =

377 importDecl m = P.ImportDeclaration m P.Unqualified Nothing

378 itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ

379 in

380− P.Module moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing

380+ P.Module [] moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing

381

382-- |

383-- Makes a volatile module to execute the current imports.

@@ -388,7 +388,7 @@ createTemporaryModuleForImports PSCiState{psciImportedModuleNames = imports} =

388 moduleName = P.ModuleName [P.ProperName "$PSCI"]

389 importDecl m = P.ImportDeclaration m P.Unqualified Nothing

390 in

391− P.Module moduleName (importDecl `map` imports) Nothing

391+ P.Module [] moduleName (importDecl `map` imports) Nothing

392

393modulesDir :: FilePath

394modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"

@@ -439,7 +439,7 @@ handleShowLoadedModules = do

439 psciIO $ readModules loadedModules >>= putStrLn

440 return ()

441 where readModules = return . unlines . sort . nub . map toModuleName

442− toModuleName = N.runModuleName . (\ (D.Module mdName _ _) -> mdName) . snd

442+ toModuleName = N.runModuleName . (\ (D.Module _ mdName _ _) -> mdName) . snd

443

444-- |

445-- Show the imported modules in psci.

@@ -510,7 +510,7 @@ handleBrowse moduleName = do

510 case env of

511 Left err -> PSCI $ outputStrLn err

512 Right env' ->

513− if moduleName `notElem` (nub . map ((\ (P.Module modName _ _ ) -> modName) . snd)) loadedModules

513+ if moduleName `notElem` (nub . map ((\ (P.Module _ modName _ _ ) -> modName) . snd)) loadedModules

514 then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."

515 else printModuleSignatures moduleName env'

516

src/Language/PureScript.hs+12−12

@@ -19,7 +19,7 @@

19{-# LANGUAGE FlexibleContexts #-}

20{-# LANGUAGE ScopedTypeVariables #-}

21

22−module Language.PureScript

22+module Language.PureScript

23 ( module P

24 , compile

25 , compile'

@@ -104,7 +104,7 @@ compile' env ms prefix = do

104 let elim = if null entryPoints then corefn else eliminateDeadCode entryPoints corefn

105 let renamed = renameInModules elim

106 let codeGenModuleNames = moduleNameFromString `map` codeGenModules additional

107− let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed

107+ let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed

108 js <- concat <$> (evalSupplyT nextVar $ T.traverse moduleToJs modulesToCodeGen)

109 let exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped

110 js' <- generateMain env' js

@@ -170,11 +170,11 @@ make :: forall m. (Functor m, Applicative m, Monad m, MonadMake m)

170 => FilePath -> [(Either RebuildPolicy FilePath, Module)] -> [String] -> m Environment

171make outputDir ms prefix = do

172 noPrelude <- asks optionsNoPrelude

173− let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)

173+ let filePathMap = M.fromList (map (\(fp, Module _ mn _ _) -> (mn, fp)) ms)

174

175 (sorted, graph) <- sortModules $ map importPrim $ if noPrelude then map snd ms else map (importPrelude . snd) ms

176

177− toRebuild <- foldM (\s (Module moduleName' _ _) -> do

177+ toRebuild <- foldM (\s (Module _ moduleName' _ _) -> do

178 let filePath = runModuleName moduleName'

179

180 jsFile = outputDir </> filePath </> "index.js"

@@ -203,18 +203,18 @@ make outputDir ms prefix = do

203 (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m

204

205 go env' ms'

206− go env ((True, m@(Module moduleName' _ exps)) : ms') = do

206+ go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do

207 let filePath = runModuleName moduleName'

208 jsFile = outputDir </> filePath </> "index.js"

209 externsFile = outputDir </> filePath </> "externs.purs"

210

211 lift . progress $ "Compiling " ++ runModuleName moduleName'

212

213− (Module _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m

213+ (Module _ _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m

214

215 regrouped <- stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated

216

217− let mod' = Module moduleName' regrouped exps

217+ let mod' = Module coms moduleName' regrouped exps

218 let corefn = CoreFn.moduleToCoreFn env' mod'

219 let [renamed] = renameInModules [corefn]

220

@@ -229,16 +229,16 @@ make outputDir ms prefix = do

229

230 rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

231 rebuildIfNecessary _ _ [] = return []

232− rebuildIfNecessary graph toRebuild (m@(Module moduleName' _ _) : ms') | moduleName' `S.member` toRebuild = do

232+ rebuildIfNecessary graph toRebuild (m@(Module _ moduleName' _ _) : ms') | moduleName' `S.member` toRebuild = do

233 let deps = fromMaybe [] $ moduleName' `M.lookup` graph

234 toRebuild' = toRebuild `S.union` S.fromList deps

235 (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'

236− rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do

236+ rebuildIfNecessary graph toRebuild (Module _ moduleName' _ _ : ms') = do

237 let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"

238 externs <- readTextFile externsFile

239 externsModules <- fmap (map snd) . either (throwError . show) return $ P.parseModulesFromFiles id [(externsFile, externs)]

240 case externsModules of

241− [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'

241+ [m'@(Module _ moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'

242 _ -> throwError $ "Externs file " ++ externsFile ++ " was invalid"

243

244reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]

@@ -251,9 +251,9 @@ reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]

251-- Add an import declaration for a module if it does not already explicitly import it.

252--

253addDefaultImport :: ModuleName -> Module -> Module

254−addDefaultImport toImport m@(Module mn decls exps) =

254+addDefaultImport toImport m@(Module coms mn decls exps) =

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

256− else Module mn (ImportDeclaration toImport Unqualified Nothing : decls) exps

256+ else Module coms mn (ImportDeclaration toImport Unqualified Nothing : decls) exps

257 where

258 isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True

259 isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

src/Language/PureScript/AST/Declarations.hs+7−6

@@ -30,14 +30,15 @@ import Language.PureScript.CodeGen.JS.AST

30import Language.PureScript.Environment

31

32-- |

33−-- A module declaration, consisting of a module name, a list of declarations, and a list of the

33+-- A module declaration, consisting of comments about the module, a module name,

34+-- a list of declarations, and a list of the declarations that are

34−-- declarations that are explicitly exported. If the export list is Nothing, everything is exported.

35+-- explicitly exported. If the export list is Nothing, everything is exported.

35--

36--

36−data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)

37+data Module = Module [Comment] ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)

37

38

38-- | Return a module's name.

39-- | Return a module's name.

39getModuleName :: Module -> ModuleName

40getModuleName :: Module -> ModuleName

40−getModuleName (Module name _ _) = name

41+getModuleName (Module _ name _ _) = name

41

42

42-- |

43-- |

43-- Test if a declaration is exported, given a module's export list.

44-- Test if a declaration is exported, given a module's export list.

@@ -60,7 +61,7 @@ isExported (Just exps) decl = any (matches decl) exps

60 matches _ _ = False

61 matches _ _ = False

61

62

62exportedDeclarations :: Module -> [Declaration]

63exportedDeclarations :: Module -> [Declaration]

63−exportedDeclarations (Module _ decls exps) = filter (isExported exps) (flattenDecls decls)

64+exportedDeclarations (Module _ _ decls exps) = filter (isExported exps) (flattenDecls decls)

64

65

65-- |

66-- |

66-- Test if a data constructor for a given type is exported, given a module's export list.

67-- Test if a data constructor for a given type is exported, given a module's export list.

@@ -78,7 +79,7 @@ isDctorExported ident (Just exps) ctor = test `any` exps

78-- Return the exported data constructors for a given type.

79-- Return the exported data constructors for a given type.

79--

80--

80exportedDctors :: Module -> ProperName -> [ProperName]

81exportedDctors :: Module -> ProperName -> [ProperName]

81−exportedDctors (Module _ decls exps) ident =

82+exportedDctors (Module _ _ decls exps) ident =

82 filter (isDctorExported ident exps) dctors

83 filter (isDctorExported ident exps) dctors

83 where

84 where

84 dctors = concatMap getDctors (flattenDecls decls)

85 dctors = concatMap getDctors (flattenDecls decls)

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

@@ -36,8 +36,8 @@ import Language.PureScript.Comments

36-- Generate foreign imports for all declarations in a module

37--

38moduleToPs :: Module -> Environment -> String

39−moduleToPs (Module _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"

39+moduleToPs (Module _ _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"

40−moduleToPs (Module moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do

40+moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do

41 tell [ "module " ++ runModuleName moduleName ++ " where"]

42 mapM_ declToPs ds

43 mapM_ exportToPs exts

src/Language/PureScript/CodeGen/JS.hs+3−3

@@ -49,14 +49,14 @@ import qualified Language.PureScript.Constants as C

49--

50moduleToJs :: (Functor m, Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m)

51 => Module Ann -> m [JS]

52−moduleToJs (Module name imps exps foreigns decls) = do

52+moduleToJs (Module coms name imps exps foreigns decls) = do

53 additional <- asks optionsAdditional

54 jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [name]) $ imps

55 let foreigns' = mapMaybe (\(_, js, _) -> js) foreigns

56 jsDecls <- mapM (bindToJs name) decls

57 optimized <- T.traverse (T.traverse optimize) jsDecls

58 let isModuleEmpty = null exps

59− let moduleBody = JSStringLiteral "use strict" : jsImports ++ foreigns' ++ concat optimized

59+ let moduleBody = JSComment coms (JSStringLiteral "use strict") : jsImports ++ foreigns' ++ concat optimized

60 let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) exps

61 return $ case additional of

62 MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']

@@ -197,7 +197,7 @@ valueToJs _ (Constructor _ _ (ProperName ctor) fields) =

197 in return $ iife ctor [ constructor

198 , JSAssignment (JSAccessor "create" (JSVar ctor)) createFn

199 ]

200−

200+

201iife :: String -> [JS] -> JS

202iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []

203

src/Language/PureScript/CoreFn/Desugar.hs+3−3

@@ -40,14 +40,14 @@ import qualified Language.PureScript.AST as A

40-- Desugars a module from AST to CoreFn representation.

41--

42moduleToCoreFn :: Environment -> A.Module -> Module Ann

43−moduleToCoreFn _ (A.Module _ _ Nothing) =

43+moduleToCoreFn _ (A.Module _ _ _ Nothing) =

44 error "Module exports were not elaborated before moduleToCoreFn"

45−moduleToCoreFn env (A.Module mn decls (Just exps)) =

45+moduleToCoreFn env (A.Module coms mn decls (Just exps)) =

46 let imports = nub $ mapMaybe importToCoreFn decls ++ findQualModules decls

47 exps' = nub $ concatMap exportToCoreFn exps

48 externs = nub $ mapMaybe externToCoreFn decls

49 decls' = concatMap (declToCoreFn Nothing []) decls

50− in Module mn imports exps' externs decls'

50+ in Module coms mn imports exps' externs decls'

51

52 where

53

src/Language/PureScript/CoreFn/Module.hs+3−1

@@ -15,12 +15,14 @@

15module Language.PureScript.CoreFn.Module where

16

17import Language.PureScript.CodeGen.JS.AST

18+import Language.PureScript.Comments

18import Language.PureScript.CoreFn.Expr

19import Language.PureScript.CoreFn.Expr

19import Language.PureScript.Names

20import Language.PureScript.Names

20import Language.PureScript.Types

21import Language.PureScript.Types

21

22

22data Module a = Module

23data Module a = Module

24+ { moduleComments :: [Comment]

23− { moduleName :: ModuleName

25+ , moduleName :: ModuleName

24 , moduleImports :: [ModuleName]

26 , moduleImports :: [ModuleName]

25 , moduleExports :: [Ident]

27 , moduleExports :: [Ident]

26 , moduleForeign :: [ForeignDecl]

28 , moduleForeign :: [ForeignDecl]

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

@@ -29,7 +29,7 @@ import Language.PureScript.Names

29eliminateDeadCode :: [ModuleName] -> [Module a] -> [Module a]

30eliminateDeadCode entryPoints ms = map go ms

31 where

32− go (Module mn imps exps foreigns ds) = Module mn imps exps' foreigns' ds'

32+ go (Module coms mn imps exps foreigns ds) = Module coms mn imps exps' foreigns' ds'

33 where

34 ds' = filter (isUsed mn graph vertexFor entryPointVertices) ds

35 foreigns' = filter (isUsed' mn graph vertexFor entryPointVertices . foreignIdent) foreigns

@@ -61,7 +61,7 @@ type Key = (ModuleName, Ident)

61-- Find dependencies for each member in a module.

62--

63declarationsByModule :: Module a -> [(Key, [Key])]

64−declarationsByModule (Module mn _ _ fs ds) =

64+declarationsByModule (Module _ mn _ _ fs ds) =

65 let fs' = map ((\name -> ((mn, name), [])) . foreignIdent) fs

66 in fs' ++ concatMap go ds

67 where

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

@@ -41,7 +41,7 @@ type ModuleGraph = [(ModuleName, [ModuleName])]

41--

42sortModules :: (MonadError String m) => [Module] -> m ([Module], ModuleGraph)

43sortModules ms = do

44− let verts = map (\m@(Module _ ds _) -> (m, getModuleName m, nub (concatMap usedModules ds))) ms

44+ let verts = map (\m@(Module _ _ ds _) -> (m, getModuleName m, nub (concatMap usedModules ds))) ms

45 ms' <- mapM toModule $ stronglyConnComp verts

46 let moduleGraph = map (\(_, mn, deps) -> (mn, deps)) verts

47 return (ms', moduleGraph)

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

@@ -242,13 +242,14 @@ parseLocalDeclaration = positioned (P.choice

242--

243parseModule :: TokenParser Module

244parseModule = do

245+ comments <- C.readComments

245 reserved "module"

246 reserved "module"

246 indented

247 indented

247 name <- moduleName

248 name <- moduleName

248 exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef

249 exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef

249 reserved "where"

250 reserved "where"

250 decls <- mark (P.many (same *> parseDeclaration))

251 decls <- mark (P.many (same *> parseDeclaration))

251− return $ Module name decls exports

252+ return $ Module comments name decls exports

252

253

253-- |

254-- |

254-- Parse a collection of modules

255-- Parse a collection of modules

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

@@ -113,7 +113,7 @@ renameInModules :: [Module Ann] -> [Module Ann]

113renameInModules = map go

114 where

115 go :: Module Ann -> Module Ann

116− go m@(Module _ _ _ _ decls) = m { moduleDecls = renameInDecl' (findDeclIdents decls) `map` decls }

116+ go m@(Module _ _ _ _ _ decls) = m { moduleDecls = renameInDecl' (findDeclIdents decls) `map` decls }

117 renameInDecl' :: [Ident] -> Bind Ann -> Bind Ann

118 renameInDecl' scope = runRename scope . renameInDecl True

119

src/Language/PureScript/Sugar/BindingGroups.hs+2−2

@@ -42,13 +42,13 @@ import Language.PureScript.Errors

42-- Replace all sets of mutually-recursive declarations in a module with binding groups

43--

44createBindingGroupsModule :: (Functor m, Applicative m, MonadError ErrorStack m) => [Module] -> m [Module]

45−createBindingGroupsModule = mapM $ \(Module name ds exps) -> Module name <$> createBindingGroups name ds <*> pure exps

45+createBindingGroupsModule = mapM $ \(Module coms name ds exps) -> Module coms name <$> createBindingGroups name ds <*> pure exps

46

47-- |

48-- Collapse all binding groups in a module to individual declarations

49--

50collapseBindingGroupsModule :: [Module] -> [Module]

51−collapseBindingGroupsModule = map $ \(Module name ds exps) -> Module name (collapseBindingGroups ds) exps

51+collapseBindingGroupsModule = map $ \(Module coms name ds exps) -> Module coms name (collapseBindingGroups ds) exps

52

53createBindingGroups :: (Functor m, Applicative m, MonadError ErrorStack m) => ModuleName -> [Declaration] -> m [Declaration]

54createBindingGroups moduleName = mapM f <=< handleDecls

src/Language/PureScript/Sugar/CaseDeclarations.hs+2−2

@@ -45,9 +45,9 @@ isLeft (Right _) = False

45-- Replace all top-level binders in a module with case expressions.

46--

47desugarCasesModule :: (Functor m, Applicative m, MonadSupply m, MonadError ErrorStack m) => [Module] -> m [Module]

48−desugarCasesModule ms = forM ms $ \(Module name ds exps) ->

48+desugarCasesModule ms = forM ms $ \(Module coms name ds exps) ->

49 rethrow (mkCompileError ("Error in module " ++ show name) Nothing `combineErrors`) $

50− Module name <$> (desugarCases <=< desugarAbs $ ds) <*> pure exps

50+ Module coms name <$> (desugarCases <=< desugarAbs $ ds) <*> pure exps

51

52desugarAbs :: (Functor m, Applicative m, MonadSupply m, MonadError ErrorStack m) => [Declaration] -> m [Declaration]

53desugarAbs = flip parU f

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

@@ -36,7 +36,7 @@ import Control.Monad.Supply.Class

36-- and all @DoNotationLet@ constructors with let expressions.

37--

38desugarDoModule :: forall m. (Applicative m, MonadSupply m, MonadError ErrorStack m) => Module -> m Module

39−desugarDoModule (Module mn ds exts) = Module mn <$> parU ds desugarDo <*> pure exts

39+desugarDoModule (Module coms mn ds exts) = Module coms mn <$> parU ds desugarDo <*> pure exts

40

41desugarDo :: forall m. (Applicative m, MonadSupply m, MonadError ErrorStack m) => Declaration -> m Declaration

42desugarDo (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (rethrowWithPosition pos $ desugarDo d)

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

@@ -161,13 +161,13 @@ desugarImports modules = do

161 -- exported members remain. If the module does not explicitly export anything, everything is

162 -- exported.

163 filterModuleExports :: ExportEnvironment -> Module -> m ExportEnvironment

164− filterModuleExports env (Module mn _ (Just exps)) = filterExports mn exps env

164+ filterModuleExports env (Module _ mn _ (Just exps)) = filterExports mn exps env

165 filterModuleExports env _ = return env

166

167 -- Rename and check all the names within a module. We tweak the global exports environment so

168 -- the module has access to an unfiltered list of its own members.

169 renameInModule' :: ExportEnvironment -> ExportEnvironment -> Module -> m Module

170− renameInModule' unfilteredExports exports m@(Module mn _ _) =

170+ renameInModule' unfilteredExports exports m@(Module _ mn _ _) =

171 rethrow (mkCompileError ("Error in module " ++ show mn) Nothing `combineErrors`) $ do

172 let env = M.update (\_ -> M.lookup mn unfilteredExports) mn exports

173 let exps = fromMaybe (error "Module is missing in renameInModule'") $ M.lookup mn exports

@@ -179,7 +179,7 @@ desugarImports modules = do

179-- as it will also make all data constructor exports explicit.

180--

181elaborateExports :: Exports -> Module -> Module

182−elaborateExports exps (Module mn decls _) = Module mn decls (Just $

182+elaborateExports exps (Module coms mn decls _) = Module coms mn decls (Just $

183 map (\(ctor, dctors) -> TypeRef ctor (Just dctors)) (exportedTypes exps) ++

184 map TypeClassRef (exportedTypeClasses exps) ++

185 map ValueRef (exportedValues exps))

@@ -189,7 +189,7 @@ elaborateExports exps (Module mn decls _) = Module mn decls (Just $

189-- This ensures transitive instances are included when using a member from a module.

190--

191elaborateImports :: Module -> Module

192−elaborateImports (Module mn decls exps) = Module mn decls' exps

192+elaborateImports (Module coms mn decls exps) = Module coms mn decls' exps

193 where

194 decls' :: [Declaration]

195 decls' =

@@ -206,8 +206,8 @@ elaborateImports (Module mn decls exps) = Module mn decls' exps

206-- qualified names are valid.

207--

208renameInModule :: forall m. (Applicative m, MonadError ErrorStack m) => ImportEnvironment -> ExportEnvironment -> Module -> m Module

209−renameInModule imports exports (Module mn decls exps) =

209+renameInModule imports exports (Module coms mn decls exps) =

210− Module mn <$> parU decls go <*> pure exps

210+ Module coms mn <$> parU decls go <*> pure exps

211 where

212 (go, _, _, _, _) = everywhereWithContextOnValuesM (Nothing, []) updateDecl updateValue updateBinder updateCase defS

213

@@ -235,7 +235,7 @@ renameInModule imports exports (Module mn decls exps) =

235 updateValue (pos, bound) (Let ds val') = do

236 let args = mapMaybe letBoundVariable ds

237 unless (length (nub args) == length args) $

238− maybe id rethrowWithPosition pos $

238+ maybe id rethrowWithPosition pos $

239 throwError $ mkErrorStack ("Overlapping names in let binding.") Nothing

240 return ((pos, args ++ bound), Let ds val')

241 where

@@ -319,7 +319,7 @@ findExports = foldM addModule $ M.singleton (ModuleName [ProperName C.prim]) pri

319

320 -- Add all of the exported declarations from a module to the global export environment

321 addModule :: ExportEnvironment -> Module -> m ExportEnvironment

322− addModule env (Module mn ds _) = do

322+ addModule env (Module _ mn ds _) = do

323 env' <- addEmptyModule env mn

324 rethrow (mkCompileError ("Error in module " ++ show mn) Nothing `combineErrors`) $ foldM (addDecl mn) env' ds

325

@@ -409,7 +409,7 @@ findImports = foldl (findImports' Nothing) M.empty

409-- Constructs a local environment for a module.

410--

411resolveImports :: forall m. (Applicative m, MonadError ErrorStack m) => ExportEnvironment -> Module -> m ImportEnvironment

412−resolveImports env (Module currentModule decls _) =

412+resolveImports env (Module _ currentModule decls _) =

413 foldM resolveImport' (ImportEnvironment M.empty M.empty M.empty M.empty) (M.toList scope)

414 where

415

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

@@ -32,7 +32,7 @@ import Language.PureScript.Errors

32import Language.PureScript.Names

33

34desugarObjectConstructors :: forall m. (Applicative m, MonadSupply m, MonadError ErrorStack m) => Module -> m Module

35−desugarObjectConstructors (Module mn ds exts) = Module mn <$> mapM desugarDecl ds <*> pure exts

35+desugarObjectConstructors (Module coms mn ds exts) = Module coms mn <$> mapM desugarDecl ds <*> pure exts

36 where

37

38 desugarDecl :: Declaration -> m Declaration

src/Language/PureScript/Sugar/Operators.hs+5−5

@@ -57,7 +57,7 @@ rebracket ms = do

57 mapM (rebracketModule opTable) ms

58

59removeSignedLiterals :: Module -> Module

60−removeSignedLiterals (Module mn ds exts) = Module mn (map f' ds) exts

60+removeSignedLiterals (Module coms mn ds exts) = Module coms mn (map f' ds) exts

61 where

62 (f', _, _) = everywhereOnValues id go id

63

@@ -65,9 +65,9 @@ removeSignedLiterals (Module mn ds exts) = Module mn (map f' ds) exts

65 go other = other

66

67rebracketModule :: (Applicative m, MonadError ErrorStack m) => [[(Qualified Ident, Expr -> Expr -> Expr, Associativity)]] -> Module -> m Module

68−rebracketModule opTable (Module mn ds exts) =

68+rebracketModule opTable (Module coms mn ds exts) =

69 let (f, _, _) = everywhereOnValuesTopDownM return (matchOperators opTable) return

70− in Module mn <$> (map removeParens <$> parU ds f) <*> pure exts

70+ in Module coms mn <$> (map removeParens <$> parU ds f) <*> pure exts

71

72removeParens :: Declaration -> Declaration

73removeParens =

@@ -78,7 +78,7 @@ removeParens =

78 go val = val

79

80collectFixities :: Module -> [(Qualified Ident, SourceSpan, Fixity)]

81−collectFixities (Module moduleName ds _) = concatMap collect ds

81+collectFixities (Module _ moduleName ds _) = concatMap collect ds

82 where

83 collect :: Declaration -> [(Qualified Ident, SourceSpan, Fixity)]

84 collect (PositionedDeclaration pos _ (FixityDeclaration fixity name)) = [(Qualified (Just moduleName) (Op name), pos, fixity)]

@@ -152,7 +152,7 @@ matchOp op = do

152 guard $ ident == op

153

154desugarOperatorSections :: forall m. (Applicative m, MonadSupply m, MonadError ErrorStack m) => Module -> m Module

155−desugarOperatorSections (Module mn ds exts) = Module mn <$> mapM goDecl ds <*> pure exts

155+desugarOperatorSections (Module coms mn ds exts) = Module coms mn <$> mapM goDecl ds <*> pure exts

156 where

157

158 goDecl :: Declaration -> m Declaration

src/Language/PureScript/Sugar/TypeClasses.hs+3−3

@@ -55,9 +55,9 @@ desugarTypeClasses :: (Functor m, Applicative m, MonadSupply m, MonadError Error

55desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule

56

57desugarModule :: (Functor m, Applicative m, MonadSupply m, MonadError ErrorStack m) => Module -> Desugar m Module

58−desugarModule (Module name decls (Just exps)) = do

58+desugarModule (Module coms name decls (Just exps)) = do

59 (newExpss, declss) <- unzip <$> parU decls (desugarDecl name exps)

60− return $ Module name (concat declss) $ Just (exps ++ catMaybes newExpss)

60+ return $ Module coms name (concat declss) $ Just (exps ++ catMaybes newExpss)

61desugarModule _ = error "Exports should have been elaborated in name desugaring"

62

63{- Desugar type class and type class instance declarations

@@ -230,7 +230,7 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =

230 m <- get

231

232 -- Lookup the type arguments and member types for the type class

233− (TypeClassDeclaration _ args implies tyDecls) <-

233+ (TypeClassDeclaration _ args implies tyDecls) <-

234 maybe (throwError $ mkErrorStack ("Type class " ++ show className ++ " is undefined") Nothing) return $

235 M.lookup (qualify mn className) m

236

src/Language/PureScript/Sugar/TypeDeclarations.hs+2−2

@@ -36,9 +36,9 @@ import Language.PureScript.Traversals

36-- Replace all top level type declarations in a module with type annotations

37--

38desugarTypeDeclarationsModule :: (Functor m, Applicative m, MonadError ErrorStack m) => [Module] -> m [Module]

39−desugarTypeDeclarationsModule ms = forM ms $ \(Module name ds exps) ->

39+desugarTypeDeclarationsModule ms = forM ms $ \(Module coms name ds exps) ->

40 rethrow (mkCompileError ("Error in module " ++ show name) Nothing `combineErrors`) $

41− Module name <$> desugarTypeDeclarations ds <*> pure exps

41+ Module coms name <$> desugarTypeDeclarations ds <*> pure exps

42

43-- |

44-- Replace all top level type declarations with type annotations

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

@@ -276,15 +276,15 @@ typeCheckAll mainModuleName moduleName exps = go

276-- required by exported members are also exported.

277--

278typeCheckModule :: Maybe ModuleName -> Module -> Check Module

279−typeCheckModule _ (Module _ _ Nothing) = error "exports should have been elaborated"

279+typeCheckModule _ (Module _ _ _ Nothing) = error "exports should have been elaborated"

280−typeCheckModule mainModuleName (Module mn decls (Just exps)) = do

280+typeCheckModule mainModuleName (Module coms mn decls (Just exps)) = do

281 modify (\s -> s { checkCurrentModule = Just mn })

282 decls' <- typeCheckAll mainModuleName mn exps decls

283 forM_ exps $ \e -> do

284 checkTypesAreExported e

285 checkClassMembersAreExported e

286 checkClassesAreExported e

287− return $ Module mn decls' (Just exps)

287+ return $ Module coms mn decls' (Just exps)

288 where

289

290 checkMemberExport :: (Show a) => String -> (Type -> [a]) -> (a -> Bool) -> DeclarationRef -> Check ()