git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Sort modules based on dependencies
commit11d65b2048fb5c2b352c9c7ee7f67dae8cdb0663 authorPhil Freeman <paf31@cantab.net> dateFri 24 Jan 2014, 10:28 (13 years ago) parent4189e7f
6 files changed+95−12
compare with golang
unifiedsplit
examples/failing/ModuleDeps.purs+7 examples/passing/ModuleDeps.purs+13 purescript.cabal+11−10 src/Language/PureScript.hs+3−1 src/Language/PureScript/ModuleDependencies.hs+61 src/Language/PureScript/Sugar/BindingGroups.hs−1
examples/failing/ModuleDeps.pursnew file+7
@@ -0,0 +1,7 @@
1+module M1 where
2+
3+import M2
4+
5+module M2 where
6+
7+import M1
examples/passing/ModuleDeps.pursnew file+13
@@ -0,0 +1,13 @@
1+module M1 where
2+
3+import M2
4+
5+foo = M3.baz
6+
7+module M2 where
8+
9+bar = M3.baz
10+
11+module M3 where
12+
13+baz = 1
purescript.cabal+11−10
@@ -11,8 +11,8 @@ synopsis: PureScript Programming Language Compiler
1111description: A small compile-to-JS language with extensible records and type-safe blocks
1212category: Language
1313author: Phil Freeman <paf31@cantab.net>
14−data-dir: ""
1514data-files: libraries/prelude/prelude.purs
15+data-dir: ""
1616
1717library
1818 build-depends: base >=4 && <5, cmdtheline -any, containers -any,
@@ -29,6 +29,7 @@ library
2929 Language.PureScript.Values
3030 Language.PureScript.Scope
3131 Language.PureScript.Sugar
32+ Language.PureScript.ModuleDependencies
3233 Language.PureScript.Sugar.CaseDeclarations
3334 Language.PureScript.Sugar.DoNotation
3435 Language.PureScript.Sugar.TypeDeclarations
@@ -63,32 +64,32 @@ library
6364 exposed: True
6465 buildable: True
6566 hs-source-dirs: src
67+ other-modules:
6668
6769executable psc
6870 build-depends: base >=4 && <5, cmdtheline -any, containers -any,
6971 directory -any, filepath -any, mtl -any, parsec -any,
7072 purescript -any, syb -any, transformers -any, utf8-string -any
7173 main-is: Main.hs
72− hs-source-dirs: psc
7374 buildable: True
75+ hs-source-dirs: psc
7476 other-modules:
7577 ghc-options: -Wall -O2 -fno-warn-unused-do-bind
7678
7779executable psci
78− build-depends: base >=4 && <5, containers -any,
79− mtl -any, parsec -any, haskeline <= 0.7.1.1,
80− purescript -any, syb -any, transformers -any, utf8-string -any,
81− process -any
80+ build-depends: base >=4 && <5, containers -any, mtl -any,
81+ parsec -any, haskeline <=0.7.1.1, purescript -any, syb -any,
82+ transformers -any, utf8-string -any, process -any
8283 main-is: Main.hs
83− hs-source-dirs: psci
8484 buildable: True
85+ hs-source-dirs: psci
8586 other-modules:
8687 ghc-options: -Wall -O2
8788
8889test-suite tests
89− build-depends: base >=4 && <5, containers -any,
90− directory -any, filepath -any, mtl -any, parsec -any,
91− purescript -any, syb -any, transformers -any, utf8-string -any
90+ build-depends: base >=4 && <5, containers -any, directory -any,
91+ filepath -any, mtl -any, parsec -any, purescript -any, syb -any,
92+ transformers -any, utf8-string -any
9293 type: exitcode-stdio-1.0
9394 main-is: Main.hs
9495 buildable: True
src/Language/PureScript.hs+3−1
@@ -25,6 +25,7 @@ import Language.PureScript.TypeChecker as P
2525import Language.PureScript.Pretty as P
2626import Language.PureScript.Sugar as P
2727import Language.PureScript.Options as P
28+import Language.PureScript.ModuleDependencies as P
2829
2930import Data.List (intercalate)
3031import Control.Monad (when, forM)
@@ -33,7 +34,8 @@ import qualified Data.Map as M
3334
3435compile :: Options -> [Module] -> Either String (String, String, Environment)
3536compile opts ms = do
36− desugared <- desugar ms
37+ sorted <- sortModules ms
38+ desugared <- desugar sorted
3739 (elaborated, env) <- runCheck $ forM desugared $ \(Module moduleName decls) -> Module moduleName <$> typeCheckAll (ModuleName moduleName) decls
3840 regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
3941 let js = concatMap (flip (moduleToJs opts) env) $ regrouped
src/Language/PureScript/ModuleDependencies.hsnew file+61
@@ -0,0 +1,61 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.ModuleDependencies
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.ModuleDependencies (
16+ sortModules
17+) where
18+
19+import Data.Data
20+import Data.Graph
21+import Data.Generics
22+import Data.List (nub, intersect)
23+import Control.Applicative ((<$>))
24+
25+import Language.PureScript.Declarations
26+import Language.PureScript.Names
27+import Language.PureScript.Values
28+import Language.PureScript.Types
29+
30+sortModules :: [Module] -> Either String [Module]
31+sortModules ms = do
32+ let verts = map (\m -> (m, getModuleName m, usedModules m)) ms
33+ mapM toModule $ stronglyConnComp verts
34+
35+collapseBindingGroups :: [Declaration] -> [Declaration]
36+collapseBindingGroups ds = concatMap go ds
37+ where
38+ go (DataBindingGroupDeclaration ds) = ds
39+ go (BindingGroupDeclaration ds) = map (\(ident, val) -> ValueDeclaration ident [] Nothing val) ds
40+ go other = [other]
41+
42+usedModules :: (Data d) => d -> [ProperName]
43+usedModules = nub . everything (++) (mkQ [] qualifiedIdents `extQ` qualifiedProperNames `extQ` imports)
44+ where
45+ qualifiedIdents :: Qualified Ident -> [ProperName]
46+ qualifiedIdents (Qualified (Just (ModuleName pn)) _) = [pn]
47+ qualifiedIdents _ = []
48+ qualifiedProperNames :: Qualified ProperName -> [ProperName]
49+ qualifiedProperNames (Qualified (Just (ModuleName pn)) _) = [pn]
50+ qualifiedProperNames _ = []
51+ imports :: Declaration -> [ProperName]
52+ imports (ImportDeclaration (ModuleName pn) _) = [pn]
53+ imports _ = []
54+
55+getModuleName :: Module -> ProperName
56+getModuleName (Module pn _) = pn
57+
58+toModule :: SCC Module -> Either String Module
59+toModule (AcyclicSCC m) = return m
60+toModule (CyclicSCC [m]) = return m
61+toModule (CyclicSCC _) = Left "Cycle in module dependencies"
src/Language/PureScript/Sugar/BindingGroups.hs−1
@@ -29,7 +29,6 @@ import Language.PureScript.Declarations
2929import Language.PureScript.Names
3030import Language.PureScript.Values
3131import Language.PureScript.Types
32−import Debug.Trace (trace)
3332
3433createBindingGroupsModule :: [Module] -> Either String [Module]
3534createBindingGroupsModule = mapM $ \(Module name ds) -> Module name <$> createBindingGroups ds