9b73cef · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Add comments to `Module`.

commit9b73cef9d8a1c4b75ad97c4c35570695b1f71c12 authorjoneshf <jones3.hardy@gmail.com> dateSat 21 Feb 2015, 12:19 (12 years ago) parentea531ab

22 files changed+75−69

compare with golang

unifiedsplit

hierarchy/Main.hs+1−1

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

6464 case modules of

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

6666 Right ms -> do

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

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

6868 let name = runModuleName moduleName

6969 tcs = filter P.isTypeClassDeclaration decls

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

psc-docs/Main.hs+3−1

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

8686 mapM_ renderModule ms

8787

8888renderModule :: P.Module -> Docs

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

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

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

9191 spacer

92+ renderComments coms

93+ spacer

9294 renderTopLevel exps (P.exportedDeclarations mdl)

9395 spacer

9496

psci/Main.hs+7−7

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

286286 getTypeName _ = Nothing

287287

288288 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) ]

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

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

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

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

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

308308

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

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

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

311311

312312 sorter :: Completion -> Completion -> Ordering

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

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

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

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

366366 in

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

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

368368

369369

370370-- |

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

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

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

379379 in

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

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

381381

382382-- |

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

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

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

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

390390 in

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

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

392392

393393modulesDir :: FilePath

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

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

439439 psciIO $ readModules loadedModules >>= putStrLn

440440 return ()

441441 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

443443

444444-- |

445445-- Show the imported modules in psci.

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

510510 case env of

511511 Left err -> PSCI $ outputStrLn err

512512 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

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

515515 else printModuleSignatures moduleName env'

516516

src/Language/PureScript.hs+12−12

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

1919{-# LANGUAGE FlexibleContexts #-}

2020{-# LANGUAGE ScopedTypeVariables #-}

2121

22−module Language.PureScript

22+module Language.PureScript

2323 ( module P

2424 , compile

2525 , compile'

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

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

105105 let renamed = renameInModules elim

106106 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

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

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

110110 js' <- generateMain env' js

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

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

171171make outputDir ms prefix = do

172172 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)

174174

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

176176

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

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

178178 let filePath = runModuleName moduleName'

179179

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

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

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

204204

205205 go env' ms'

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

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

207207 let filePath = runModuleName moduleName'

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

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

210210

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

212212

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

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

214214

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

216216

217− let mod' = Module moduleName' regrouped exps

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

218218 let corefn = CoreFn.moduleToCoreFn env' mod'

219219 let [renamed] = renameInModules [corefn]

220220

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

229229

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

231231 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

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

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

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

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

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

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

238238 externs <- readTextFile externsFile

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

240240 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'

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

243243

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

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

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

252252--

253253addDefaultImport :: ModuleName -> Module -> Module

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

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

255255 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

257257 where

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

259259 isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

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

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

3030import Language.PureScript.Environment

3131

3232-- |

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

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

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

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

3536--

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)

3738

3839-- | Return a module's name.

3940getModuleName :: Module -> ModuleName

40−getModuleName (Module name _ _) = name

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

4142

4243-- |

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

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

6061 matches _ _ = False

6162

6263exportedDeclarations :: Module -> [Declaration]

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

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

6465

6566-- |

6667-- 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

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

7980--

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

81−exportedDctors (Module _ decls exps) ident =

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

8283 filter (isDctorExported ident exps) dctors

8384 where

8485 dctors = concatMap getDctors (flattenDecls decls)

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

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

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

3737--

3838moduleToPs :: Module -> Environment -> String

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

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

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

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

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

4242 mapM_ declToPs ds

4343 mapM_ exportToPs exts

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

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

4949--

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

5151 => Module Ann -> m [JS]

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

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

5353 additional <- asks optionsAdditional

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

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

5656 jsDecls <- mapM (bindToJs name) decls

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

5858 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

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

6161 return $ case additional of

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

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

197197 in return $ iife ctor [ constructor

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

199199 ]

200−

200+

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

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

203203

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

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

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

4141--

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

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

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

4444 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)) =

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

4747 exps' = nub $ concatMap exportToCoreFn exps

4848 externs = nub $ mapMaybe externToCoreFn decls

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

50− in Module mn imports exps' externs decls'

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

5151

5252 where

5353

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

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

1515module Language.PureScript.CoreFn.Module where

1616

1717import Language.PureScript.CodeGen.JS.AST

18+import Language.PureScript.Comments

1819import Language.PureScript.CoreFn.Expr

1920import Language.PureScript.Names

2021import Language.PureScript.Types

2122

2223data Module a = Module

23− { moduleName :: ModuleName

24+ { moduleComments :: [Comment]

25+ , moduleName :: ModuleName

2426 , moduleImports :: [ModuleName]

2527 , moduleExports :: [Ident]

2628 , moduleForeign :: [ForeignDecl]

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

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

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

3030eliminateDeadCode entryPoints ms = map go ms

3131 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'

3333 where

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

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

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

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

6262--

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

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

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

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

6666 in fs' ++ concatMap go ds

6767 where

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

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

4141--

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

4343sortModules 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

4545 ms' <- mapM toModule $ stronglyConnComp verts

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

4747 return (ms', moduleGraph)

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

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

242242--

243243parseModule :: TokenParser Module

244244parseModule = do

245+ comments <- C.readComments

245246 reserved "module"

246247 indented

247248 name <- moduleName

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

249250 reserved "where"

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

251− return $ Module name decls exports

252+ return $ Module comments name decls exports

252253

253254-- |

254255-- Parse a collection of modules

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

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

113113renameInModules = map go

114114 where

115115 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 }

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

118118 renameInDecl' scope = runRename scope . renameInDecl True

119119

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

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

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

4343--

4444createBindingGroupsModule :: (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

4646

4747-- |

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

4949--

5050collapseBindingGroupsModule :: [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

5252

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

5454createBindingGroups moduleName = mapM f <=< handleDecls

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

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

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

4646--

4747desugarCasesModule :: (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) ->

4949 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

5151

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

5353desugarAbs = flip parU f

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

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

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

3737--

3838desugarDoModule :: 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

4040

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

4242desugarDo (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

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

162162 -- exported.

163163 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

165165 filterModuleExports env _ = return env

166166

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

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

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

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

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

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

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

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

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

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

180180--

181181elaborateExports :: 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 $

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

184184 map TypeClassRef (exportedTypeClasses exps) ++

185185 map ValueRef (exportedValues exps))

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

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

190190--

191191elaborateImports :: Module -> Module

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

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

193193 where

194194 decls' :: [Declaration]

195195 decls' =

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

206206-- qualified names are valid.

207207--

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

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

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

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

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

211211 where

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

213213

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

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

236236 let args = mapMaybe letBoundVariable ds

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

238− maybe id rethrowWithPosition pos $

238+ maybe id rethrowWithPosition pos $

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

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

241241 where

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

319319

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

321321 addModule :: ExportEnvironment -> Module -> m ExportEnvironment

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

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

323323 env' <- addEmptyModule env mn

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

325325

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

409409-- Constructs a local environment for a module.

410410--

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

412−resolveImports env (Module currentModule decls _) =

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

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

414414 where

415415

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

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

3232import Language.PureScript.Names

3333

3434desugarObjectConstructors :: 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

3636 where

3737

3838 desugarDecl :: Declaration -> m Declaration

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

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

5757 mapM (rebracketModule opTable) ms

5858

5959removeSignedLiterals :: 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

6161 where

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

6363

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

6565 go other = other

6666

6767rebracketModule :: (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) =

6969 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

7171

7272removeParens :: Declaration -> Declaration

7373removeParens =

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

7878 go val = val

7979

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

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

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

8282 where

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

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

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

152152 guard $ ident == op

153153

154154desugarOperatorSections :: 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

156156 where

157157

158158 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

5555desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule

5656

5757desugarModule :: (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

5959 (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)

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

6262

6363{- Desugar type class and type class instance declarations

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

230230 m <- get

231231

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

233− (TypeClassDeclaration _ args implies tyDecls) <-

233+ (TypeClassDeclaration _ args implies tyDecls) <-

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

235235 M.lookup (qualify mn className) m

236236

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

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

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

3737--

3838desugarTypeDeclarationsModule :: (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) ->

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

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

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

4242

4343-- |

4444-- 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

276276-- required by exported members are also exported.

277277--

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

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

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

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

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

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

282282 decls' <- typeCheckAll mainModuleName mn exps decls

283283 forM_ exps $ \e -> do

284284 checkTypesAreExported e

285285 checkClassMembersAreExported e

286286 checkClassesAreExported e

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

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

288288 where

289289

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