git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Parallelize json->cpp compilation
0ee3826Andy Arvanitis
app/Main.hs+23−15
compare with golang
unifiedsplit
@@ -5,6 +5,7 @@
5module Main where
5module Main where
6
6
7import Control.Monad (when)
7import Control.Monad (when)
8+import qualified Control.Monad.Parallel as Par
8import Data.Aeson
9import Data.Aeson
9import Data.Aeson.Types
10import Data.Aeson.Types
10import Data.Char
11import Data.Char
@@ -64,11 +65,16 @@ main = do
64 T.writeFile "Makefile" $ T.decodeUtf8 $(embedFile "support/Makefile")
65 T.writeFile "Makefile" $ T.decodeUtf8 $(embedFile "support/Makefile")
65 when ("--help" `elem` opts') $
66 when ("--help" `elem` opts') $
66 putStrLn help
67 putStrLn help
68+ when (not $ null files) $ do
69+ let filepath = takeDirectory (head files)
70+ baseOutpath = joinPath $ (init $ splitDirectories filepath) ++ [outdir]
71+ writeRuntimeFiles baseOutpath
67− mapM (generateCode opts') files
72+ Par.mapM (generateCode opts' baseOutpath) files
73+ return ()
68 return ()
74 return ()
69
75
70−generateCode :: [String] -> FilePath -> IO ()
76+generateCode :: [String] -> FilePath -> FilePath -> IO ()
71−generateCode opts jsonFile = do
77+generateCode opts baseOutpath jsonFile = do
72 jsonModTime <- getModificationTime jsonFile
78 jsonModTime <- getModificationTime jsonFile
73 let filepath = takeDirectory jsonFile
79 let filepath = takeDirectory jsonFile
74 dirparts = splitDirectories $ filepath
80 dirparts = splitDirectories $ filepath
@@ -80,18 +86,16 @@ generateCode opts jsonFile = do
80 then do
86 then do
81 modTime <- getModificationTime possInterfaceFilename
87 modTime <- getModificationTime possInterfaceFilename
82 when (modTime < jsonModTime) $
88 when (modTime < jsonModTime) $
83− transpile opts jsonFile
89+ transpile opts baseOutpath jsonFile
84− else transpile opts jsonFile
90+ else transpile opts baseOutpath jsonFile
85
91
86−transpile :: [String] -> FilePath -> IO ()
92+transpile :: [String] -> FilePath -> FilePath -> IO ()
87−transpile opts jsonFile = do
93+transpile opts baseOutpath jsonFile = do
88 jsonText <- T.readFile jsonFile
94 jsonText <- T.readFile jsonFile
89 let module' = jsonToModule $ parseJson jsonText
95 let module' = jsonToModule $ parseJson jsonText
90 ((interface, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToCpp module' Nothing)
96 ((interface, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToCpp module' Nothing)
91 let mn = moduleNameToCpp $ moduleName module'
97 let mn = moduleNameToCpp $ moduleName module'
92 implementation = prettyPrintCpp asts
98 implementation = prettyPrintCpp asts
93− filepath = takeDirectory jsonFile
94− let baseOutpath = joinPath $ (init $ splitDirectories filepath) ++ [outdir]
95 outpath = joinPath [baseOutpath, T.unpack mn]
99 outpath = joinPath [baseOutpath, T.unpack mn]
96 interfacePath = outpath </> interfaceFileName (T.unpack mn)
100 interfacePath = outpath </> interfaceFileName (T.unpack mn)
97 implPath = outpath </> implFileName mn
101 implPath = outpath </> implFileName mn
@@ -100,18 +104,22 @@ transpile opts jsonFile = do
100 T.writeFile interfacePath $ conv interface
104 T.writeFile interfacePath $ conv interface
101 putStrLn implPath
105 putStrLn implPath
102 T.writeFile implPath $ conv (implHeader <> implementation <> implFooter)
106 T.writeFile implPath $ conv (implHeader <> implementation <> implFooter)
103− let runtime = baseOutpath </> "purescript.h"
104− dep = baseOutpath </> "string_literal_dict.h"
105− runtimeExists <- doesFileExist runtime
106− when (not runtimeExists) $ do
107− T.writeFile runtime . conv $ T.decodeUtf8 $(embedFile "runtime/purescript.h")
108− T.writeFile dep . conv $ T.decodeUtf8 $(embedFile "runtime/string_literal_dict.h")
109 where
107 where
110 conv :: Text -> Text
108 conv :: Text -> Text
111 conv
109 conv
112 | "--ucns" `elem` opts = toUCNs
110 | "--ucns" `elem` opts = toUCNs
113 | otherwise = id
111 | otherwise = id
114
112
113+writeRuntimeFiles :: FilePath -> IO ()
114+writeRuntimeFiles baseOutpath = do
115+ createDirectoryIfMissing True baseOutpath
116+ let runtime = baseOutpath </> "purescript.h"
117+ dep = baseOutpath </> "string_literal_dict.h"
118+ runtimeExists <- doesFileExist runtime
119+ when (not runtimeExists) $ do
120+ T.writeFile runtime $ T.decodeUtf8 $(embedFile "runtime/purescript.h")
121+ T.writeFile dep $ T.decodeUtf8 $(embedFile "runtime/string_literal_dict.h")
122+
115outdir :: FilePath
123outdir :: FilePath
116outdir = "src"
124outdir = "src"
117
125
package.yaml+1
@@ -27,6 +27,7 @@ dependencies:
27- text
27- text
28- containers
28- containers
29- filepath
29- filepath
30+- monad-parallel >= 0.7.2.2 && <0.8
30- pattern-arrows >=0.0.2 && <0.1
31- pattern-arrows >=0.0.2 && <0.1
31- safe >=0.3.9 && <0.4
32- safe >=0.3.9 && <0.4
32- transformers >=0.3.0 && <0.6
33- transformers >=0.3.0 && <0.6
pscpp.cabal+4−1
@@ -2,7 +2,7 @@
2--
2--
3-- see: https://github.com/sol/hpack
3-- see: https://github.com/sol/hpack
4--
4--
5−-- hash: e5a3087784164da529b9f673d964db77b198c936e428ed7c2fe54b479a06d0c7
5+-- hash: 359fb647874c687db6015861dc97b20ba11f47258cc05324f1d925d939cb6024
6
6
7name: pscpp
7name: pscpp
8version: 0.1.0.0
8version: 0.1.0.0
@@ -45,6 +45,7 @@ library
45 , directory
45 , directory
46 , file-embed
46 , file-embed
47 , filepath
47 , filepath
48+ , monad-parallel >=0.7.2.2 && <0.8
48 , mtl >=2.1.0 && <2.3.0
49 , mtl >=2.1.0 && <2.3.0
49 , pattern-arrows >=0.0.2 && <0.1
50 , pattern-arrows >=0.0.2 && <0.1
50 , process
51 , process
@@ -70,6 +71,7 @@ executable pscpp
70 , directory
71 , directory
71 , file-embed
72 , file-embed
72 , filepath
73 , filepath
74+ , monad-parallel >=0.7.2.2 && <0.8
73 , mtl >=2.1.0 && <2.3.0
75 , mtl >=2.1.0 && <2.3.0
74 , pattern-arrows >=0.0.2 && <0.1
76 , pattern-arrows >=0.0.2 && <0.1
75 , process
77 , process
@@ -97,6 +99,7 @@ test-suite pscpp-test
97 , directory
99 , directory
98 , file-embed
100 , file-embed
99 , filepath
101 , filepath
102+ , monad-parallel >=0.7.2.2 && <0.8
100 , mtl >=2.1.0 && <2.3.0
103 , mtl >=2.1.0 && <2.3.0
101 , pattern-arrows >=0.0.2 && <0.1
104 , pattern-arrows >=0.0.2 && <0.1
102 , process
105 , process