Skip to content

Commit d3f368b

Browse files
garybgaryb
committed
Change ModuleName to accept [ProperName]
1 parent 1e3c158 commit d3f368b

File tree

19 files changed

+70
-63
lines changed

19 files changed

+70
-63
lines changed

‎docgen/Main.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -59,8 +59,8 @@ renderModules ms = do
5959
mapM_ renderModule ms
6060

6161
renderModule :: P.Module -> Docs
62-
renderModule (P.Module (P.ProperName moduleName) ds) = do
63-
headerLevel 2 $ "Module " ++ moduleName
62+
renderModule (P.Module moduleName ds) = do
63+
headerLevel 2 $ "Module " ++ (P.runModuleName moduleName)
6464
spacer
6565
headerLevel 3 "Types"
6666
spacer

‎psci/Main.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ completion ms = completeWord Nothing " \t\n\r" findCompletions
5151
| P.Module moduleName ds <- ms
5252
, ident <- mapMaybe getDeclName ds
5353
, qual <- [ P.Qualified Nothing ident
54-
, P.Qualified (Just (P.ModuleName moduleName)) ident]
54+
, P.Qualified (Just moduleName) ident]
5555
]
5656
let matches = filter (isPrefixOf str) names
5757
return $ map simpleCompletion matches ++ files
@@ -62,16 +62,16 @@ completion ms = completeWord Nothing " \t\n\r" findCompletions
6262
createTemporaryModule :: [P.ProperName] -> P.Value -> P.Module
6363
createTemporaryModule imports value =
6464
let
65-
moduleName = P.ProperName "Main"
65+
moduleName = P.ModuleName [P.ProperName "Main"]
6666
importDecl m = P.ImportDeclaration m Nothing
67-
traceModule = P.ModuleName (P.ProperName "Trace")
67+
traceModule = P.ModuleName [P.ProperName "Trace"]
6868
trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
6969
mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing
7070
(P.Do [ P.DoNotationBind (P.VarBinder (P.Ident "it")) value
7171
, P.DoNotationValue (P.App trace (P.Var (P.Qualified Nothing (P.Ident "it"))) )
7272
])
7373
in
74-
P.Module moduleName $ map (importDecl . P.ModuleName) imports ++ [mainDecl]
74+
P.Module moduleName $ map (importDecl . P.ModuleName . return) imports ++ [mainDecl]
7575

7676
handleDeclaration :: [P.Module] -> [P.ProperName] -> P.Value -> InputT IO ()
7777
handleDeclaration loadedModules imports value = do

‎src/Language/PureScript.hs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -60,19 +60,19 @@ compile opts ms = do
6060
sorted <- sortModules ms
6161
desugared <- desugar sorted
6262
(elaborated, env) <- runCheck $ forM desugared $ \(Module moduleName decls) -> do
63-
modify (\s -> s { checkCurrentModule = Just (ModuleName moduleName) })
64-
Module moduleName <$> typeCheckAll mainModuleIdent (ModuleName moduleName) decls
63+
modify (\s -> s { checkCurrentModule = Just moduleName })
64+
Module moduleName <$> typeCheckAll mainModuleIdent moduleName decls
6565
regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
66-
let entryPoints = optionsModules opts
66+
let entryPoints = (ModuleName . return . ProperName) `map` optionsModules opts
6767
let elim = if null entryPoints then regrouped else eliminateDeadCode env entryPoints regrouped
6868
let js = mapMaybe (flip (moduleToJs opts) env) elim
6969
let exts = intercalate "\n" . map (flip moduleToPs env) $ elim
7070
js' <- case optionsMain opts of
7171
Just mainModuleName -> do
72-
when ((ModuleName (ProperName mainModuleName), Ident "main") `M.notMember` (names env)) $
72+
when ((ModuleName [ProperName mainModuleName], Ident "main") `M.notMember` (names env)) $
7373
Left $ mainModuleName ++ ".main is undefined"
7474
return $ js ++ [JSApp (JSAccessor "main" (JSAccessor mainModuleName (JSVar "_ps"))) []]
7575
_ -> return js
7676
return (prettyPrintJS [(wrapExportsContainer opts js')], exts, env)
7777
where
78-
mainModuleIdent = ModuleName . ProperName <$> (optionsMain opts)
78+
mainModuleIdent = (ModuleName . return . ProperName) <$> optionsMain opts

‎src/Language/PureScript/CodeGen/Externs.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -29,9 +29,9 @@ import Data.List (intercalate)
2929
-- Generate foreign imports for all declarations in a module
3030
--
3131
moduleToPs :: Module -> Environment -> String
32-
moduleToPs (Module pname@(ProperName moduleName) decls) env =
33-
"module " ++ moduleName ++ " where\n" ++
34-
(intercalate "\n" . map (" " ++) . concatMap (declToPs (ModuleName pname) env) $ decls)
32+
moduleToPs (Module mn decls) env =
33+
"module " ++ (runModuleName mn) ++ " where\n" ++
34+
(intercalate "\n" . map (" " ++) . concatMap (declToPs mn env) $ decls)
3535

3636
declToPs :: ModuleName -> Environment -> Declaration -> [String]
3737
declToPs path env (ValueDeclaration name _ _ _) = maybeToList $ do

‎src/Language/PureScript/CodeGen/JS.hs‎

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ module Language.PureScript.CodeGen.JS (
2323
) where
2424

2525
import Data.Maybe (fromMaybe, mapMaybe)
26-
import Data.List (sortBy)
26+
import Data.List (sortBy, intercalate)
2727
import Data.Function (on)
2828
import Data.Data (Data)
2929
import Data.Generics (mkQ, everything)
@@ -52,14 +52,17 @@ import Language.PureScript.TypeChecker.Monad (canonicalizeDataConstructor)
5252
-- module.
5353
--
5454
moduleToJs :: Options -> Module -> Environment -> Maybe JS
55-
moduleToJs opts (Module pname@(ProperName name) decls) env =
55+
moduleToJs opts (Module name decls) env =
5656
case jsDecls of
5757
[] -> Nothing
58-
_ -> Just $ JSAssignment (JSAccessor name (JSVar "_ps")) $
58+
_ -> Just $ JSAssignment (JSAccessor (moduleNameToJS name) (JSVar "_ps")) $
5959
JSApp (JSFunction Nothing ["module"] (JSBlock $ jsDecls ++ [JSReturn $ JSVar "module"]))
60-
[(JSBinary Or (JSAccessor name (JSVar "_ps")) (JSObjectLiteral []))]
60+
[(JSBinary Or (JSAccessor (moduleNameToJS name) (JSVar "_ps")) (JSObjectLiteral []))]
6161
where
62-
jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts (ModuleName pname) decl env) (decls))
62+
jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts name decl env) (decls))
63+
64+
moduleNameToJS :: ModuleName -> String
65+
moduleNameToJS (ModuleName pns) = intercalate "_" (runProperName `map` pns)
6366

6467
-- |
6568
-- Generate code in the simplified Javascript intermediate representation for a declaration
@@ -212,7 +215,7 @@ varToJs m e qual@(Qualified _ ident) = go qual
212215
-- variable that may have a qualified name.
213216
--
214217
qualifiedToJS :: ModuleName -> (a -> Ident) -> Qualified a -> JS
215-
qualifiedToJS m f (Qualified (Just m'@(ModuleName (ProperName mn))) a) | m /= m' = accessor (f a) (JSAccessor mn $ JSVar "_ps")
218+
qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSAccessor (moduleNameToJS m') $ JSVar "_ps")
216219
qualifiedToJS m f (Qualified _ a) = JSVar $ identToJs (f a)
217220

218221
-- |

‎src/Language/PureScript/CodeGen/Optimize.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -284,8 +284,8 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)
284284
isRetPoly (JSIndexer (JSStringLiteral "return") (JSAccessor "Prelude" (JSVar "_ps"))) = True
285285
isRetPoly _ = False
286286

287-
prelude = ModuleName (ProperName "Prelude")
288-
effModule = ModuleName (ProperName "Eff")
287+
prelude = ModuleName [ProperName "Prelude"]
288+
effModule = ModuleName [ProperName "Eff"]
289289

290290
Right (Ident effDictName) = mkDictionaryValueName
291291
effModule
@@ -382,7 +382,7 @@ inlineCommonOperators = applyAll
382382
isOpDict className ty (JSApp (JSAccessor prop (JSAccessor "Prelude" (JSVar "_ps"))) [JSObjectLiteral []]) | prop == dictName = True
383383
where
384384
Right (Ident dictName) = mkDictionaryValueName
385-
(ModuleName (ProperName "Prim"))
386-
(Qualified (Just (ModuleName (ProperName "Prelude"))) (ProperName className))
385+
(ModuleName [ProperName "Prim"])
386+
(Qualified (Just (ModuleName [ProperName "Prelude"])) (ProperName className))
387387
ty
388388
isOpDict _ _ _ = False

‎src/Language/PureScript/DeadCodeElimination.hs‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -30,23 +30,23 @@ import Language.PureScript.TypeChecker.Monad
3030
-- |
3131
-- Eliminate all declarations which are not a transitive dependency of the entry point module
3232
--
33-
eliminateDeadCode :: Environment -> [String] -> [Module] -> [Module]
33+
eliminateDeadCode :: Environment -> [ModuleName] -> [Module] -> [Module]
3434
eliminateDeadCode env entryPoints ms =
3535
let declarations = concatMap (declarationsByModule env) ms
3636
(graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
37-
entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((ModuleName (ProperName mn), _), _) -> mn `elem` entryPoints) $ declarations
38-
in flip map ms $ \(Module moduleName ds) -> Module moduleName (filter (isUsed (ModuleName moduleName) graph vertexFor entryPointVertices) ds)
37+
entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
38+
in flip map ms $ \(Module moduleName ds) -> Module moduleName (filter (isUsed (moduleName) graph vertexFor entryPointVertices) ds)
3939

4040
type Key = (ModuleName, Either Ident ProperName)
4141

4242
declarationsByModule :: Environment -> Module -> [(Key, [Key])]
4343
declarationsByModule env (Module moduleName ds) = concatMap go $ ds
4444
where
4545
go :: Declaration -> [(Key, [Key])]
46-
go d@(ValueDeclaration name _ _ _) = [((ModuleName moduleName, Left name), dependencies env (ModuleName moduleName) d)]
47-
go (DataDeclaration _ _ dctors) = map (\(name, _) -> ((ModuleName moduleName, Right name), [])) dctors
48-
go (ExternDeclaration _ name _ _) = [((ModuleName moduleName, Left name), [])]
49-
go d@(BindingGroupDeclaration names) = map (\(name, _) -> ((ModuleName moduleName, Left name), dependencies env (ModuleName moduleName) d)) names
46+
go d@(ValueDeclaration name _ _ _) = [((moduleName, Left name), dependencies env (moduleName) d)]
47+
go (DataDeclaration _ _ dctors) = map (\(name, _) -> ((moduleName, Right name), [])) dctors
48+
go (ExternDeclaration _ name _ _) = [((moduleName, Left name), [])]
49+
go d@(BindingGroupDeclaration names) = map (\(name, _) -> ((moduleName, Left name), dependencies env moduleName d)) names
5050
go (DataBindingGroupDeclaration ds) = concatMap go ds
5151
go _ = []
5252

‎src/Language/PureScript/Declarations.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable
4242
-- |
4343
-- A module declaration, consisting of a module name and a list of declarations
4444
--
45-
data Module = Module ProperName [Declaration] deriving (Show, D.Data, D.Typeable)
45+
data Module = Module ModuleName [Declaration] deriving (Show, D.Data, D.Typeable)
4646

4747
-- |
4848
-- The type of a foreign import

‎src/Language/PureScript/ModuleDependencies.hs‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -40,21 +40,21 @@ sortModules ms = do
4040
-- |
4141
-- Calculate a list of used modules based on explicit imports and qualified names
4242
--
43-
usedModules :: (Data d) => d -> [ProperName]
43+
usedModules :: (Data d) => d -> [ModuleName]
4444
usedModules = nub . everything (++) (mkQ [] qualifiedIdents `extQ` qualifiedProperNames `extQ` imports)
4545
where
46-
qualifiedIdents :: Qualified Ident -> [ProperName]
47-
qualifiedIdents (Qualified (Just (ModuleName pn)) _) = [pn]
46+
qualifiedIdents :: Qualified Ident -> [ModuleName]
47+
qualifiedIdents (Qualified (Just mn) _) = [mn]
4848
qualifiedIdents _ = []
49-
qualifiedProperNames :: Qualified ProperName -> [ProperName]
50-
qualifiedProperNames (Qualified (Just (ModuleName pn)) _) = [pn]
49+
qualifiedProperNames :: Qualified ProperName -> [ModuleName]
50+
qualifiedProperNames (Qualified (Just mn) _) = [mn]
5151
qualifiedProperNames _ = []
52-
imports :: Declaration -> [ProperName]
53-
imports (ImportDeclaration (ModuleName pn) _) = [pn]
52+
imports :: Declaration -> [ModuleName]
53+
imports (ImportDeclaration mn _) = [mn]
5454
imports _ = []
5555

56-
getModuleName :: Module -> ProperName
57-
getModuleName (Module pn _) = pn
56+
getModuleName :: Module -> ModuleName
57+
getModuleName (Module mn _) = mn
5858

5959
-- |
6060
-- Convert a strongly connected component of the module graph to a module

‎src/Language/PureScript/Names.hs‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@
1717

1818
module Language.PureScript.Names where
1919

20+
import Data.List
2021
import Data.Data
2122
import Data.Function (on)
2223

@@ -64,10 +65,13 @@ instance Show ProperName where
6465
-- |
6566
-- Module names
6667
--
67-
data ModuleName = ModuleName { runModuleName :: ProperName } deriving (Eq, Ord, Data, Typeable)
68+
data ModuleName = ModuleName [ProperName] deriving (Eq, Ord, Data, Typeable)
69+
70+
runModuleName :: ModuleName -> String
71+
runModuleName (ModuleName pns) = intercalate "." (runProperName `map` pns)
6872

6973
instance Show ModuleName where
70-
show (ModuleName name) = show name
74+
show = runModuleName
7175

7276
-- |
7377
-- A qualified name, i.e. a name with an optional module name

0 commit comments

Comments
 (0)