8d394d9 · rowtype-yoga/purescript-native

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

on golang help sign in

Move JS codegen for compile into psc

8d394d9Gary Burgess11 years ago

psc/Main.hs+59−19

compare with golang

unifiedsplit

@@ -12,40 +12,52 @@

12--

13-----------------------------------------------------------------------------

15−{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}

15+{-# LANGUAGE DataKinds #-}

16+{-# LANGUAGE FlexibleContexts #-}

17+{-# LANGUAGE RecordWildCards #-}

18+{-# LANGUAGE ScopedTypeVariables #-}

19+{-# LANGUAGE TupleSections #-}

17module Main where

21module Main where

19import Control.Applicative

23import Control.Applicative

20import Control.Monad

24import Control.Monad

25+import Control.Monad.Error.Class (MonadError(..))

21import Control.Monad.Reader

26import Control.Monad.Reader

27+import Control.Monad.Supply (evalSupplyT)

22import Control.Monad.Writer

28import Control.Monad.Writer

24import Data.Maybe (fromMaybe)

30import Data.Maybe (fromMaybe)

31+import Data.Traversable (traverse)

25import Data.Version (showVersion)

32import Data.Version (showVersion)

27import Options.Applicative as Opts

34import Options.Applicative as Opts

35+

28import System.Directory (createDirectoryIfMissing)

36import System.Directory (createDirectoryIfMissing)

29−import System.FilePath (takeDirectory)

30import System.Exit (exitSuccess, exitFailure)

37import System.Exit (exitSuccess, exitFailure)

38+import System.FilePath (takeDirectory)

31−import System.IO (hPutStrLn, stderr)

39+import System.IO (hPrint, hPutStrLn, stderr)

41+import qualified Data.Map as M

33import qualified Language.PureScript as P

42import qualified Language.PureScript as P

43+import qualified Language.PureScript.Constants as C

44+import qualified Language.PureScript.CodeGen.JS as J

34import qualified Paths_purescript as Paths

45import qualified Paths_purescript as Paths

36data PSCOptions = PSCOptions

47data PSCOptions = PSCOptions

37− { pscInput :: [FilePath]

48+ { pscInput :: [FilePath]

49+ , pscForeignInput :: [FilePath]

38− , pscOpts :: P.Options P.Compile

50+ , pscOpts :: P.Options P.Compile

39− , pscStdIn :: Bool

51+ , pscStdIn :: Bool

40− , pscOutput :: Maybe FilePath

52+ , pscOutput :: Maybe FilePath

41− , pscExterns :: Maybe FilePath

53+ , pscExterns :: Maybe FilePath

42− , pscUsePrefix :: Bool

54+ , pscUsePrefix :: Bool

43 }

55 }

45data InputOptions = InputOptions

57data InputOptions = InputOptions

46− { ioNoPrelude :: Bool

58+ { ioNoPrelude :: Bool

47− , ioUseStdIn :: Bool

59+ , ioUseStdIn :: Bool

48− , ioInputFiles :: [FilePath]

60+ , ioInputFiles :: [FilePath]

49 }

61 }

51readInput :: InputOptions -> IO [(Maybe FilePath, String)]

63readInput :: InputOptions -> IO [(Maybe FilePath, String)]

@@ -59,19 +71,19 @@ runPSC :: P.Options P.Compile -> PSC a -> Either P.MultipleErrors (a, P.Multiple

59runPSC opts rwe = runWriterT (runReaderT rwe opts)

71runPSC opts rwe = runWriterT (runReaderT rwe opts)

61compile :: PSCOptions -> IO ()

73compile :: PSCOptions -> IO ()

62−compile (PSCOptions input opts stdin output externs usePrefix) = do

74+compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do

63 modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)

75 modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)

64 case modules of

76 case modules of

65 Left err -> do

77 Left err -> do

66− hPutStrLn stderr $ show err

78+ hPrint stderr err

67 exitFailure

79 exitFailure

68− Right ms -> do

80+ Right ms ->

69− case runPSC opts (P.compile (map snd ms) prefix) of

81+ case runPSC opts (compileJS (map snd ms) M.empty) of

70 Left errs -> do

82 Left errs -> do

71 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)

83 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)

72 exitFailure

84 exitFailure

73− Right ((js, exts, _), warnings) -> do

85+ Right ((js, exts), warnings) -> do

74− when (P.nonEmpty warnings) $

86+ when (P.nonEmpty warnings) $

75 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)

87 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)

76 case output of

88 case output of

77 Just path -> mkdirp path >> writeFile path js

89 Just path -> mkdirp path >> writeFile path js

@@ -85,6 +97,28 @@ compile (PSCOptions input opts stdin output externs usePrefix) = do

85 then ["Generated by psc version " ++ showVersion Paths.version]

97 then ["Generated by psc version " ++ showVersion Paths.version]

86 else []

98 else []

100+ compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)

101+ => [P.Module] -> M.Map P.ModuleName String -> m (String, String)

102+ compileJS ms foreigns = do

103+ (modulesToCodeGen, exts, env, nextVar) <- P.compile ms

104+ js <- concat <$> evalSupplyT nextVar (traverse J.moduleToJs modulesToCodeGen)

105+ js' <- generateMain env js

106+ let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']

107+ return (pjs, exts)

108+

109+ where

110+

111+ generateMain :: P.Environment -> [J.JS] -> m [J.JS]

112+ generateMain env js = do

113+ mainName <- asks P.optionsMain

114+ additional <- asks P.optionsAdditional

115+ case P.moduleNameFromString <$> mainName of

116+ Just mmi -> do

117+ when ((mmi, P.Ident C.main) `M.notMember` P.names env) $

118+ throwError . P.errorMessage $ P.NameIsUndefined (P.Ident C.main)

119+ return $ js ++ [J.mainCall mmi (P.browserNamespace additional)]

120+ _ -> return js

121+

88mkdirp :: FilePath -> IO ()

122mkdirp :: FilePath -> IO ()

89mkdirp = createDirectoryIfMissing True . takeDirectory

123mkdirp = createDirectoryIfMissing True . takeDirectory

124

@@ -161,6 +195,12 @@ inputFile = strArgument $

161 metavar "FILE"

195 metavar "FILE"

162 <> help "The input .purs file(s)"

196 <> help "The input .purs file(s)"

163

197

198+inputForeignFile :: Parser FilePath

199+inputForeignFile = strOption $

200+ short 'f'

201+ <> long "ffi"

202+ <> help "The input .purs file(s)"

203+

164outputFile :: Parser (Maybe FilePath)

204outputFile :: Parser (Maybe FilePath)

165outputFile = optional . strOption $

205outputFile = optional . strOption $

166 short 'o'

206 short 'o'

@@ -196,6 +236,7 @@ options = P.Options <$> noPrelude

196

236

197pscOptions :: Parser PSCOptions

237pscOptions :: Parser PSCOptions

198pscOptions = PSCOptions <$> many inputFile

238pscOptions = PSCOptions <$> many inputFile

239+ <*> many inputForeignFile

199 <*> options

240 <*> options

200 <*> useStdIn

241 <*> useStdIn

201 <*> outputFile

242 <*> outputFile

@@ -212,4 +253,3 @@ main = execParser opts >>= compile

212

253

213 version :: Parser (a -> a)

254 version :: Parser (a -> a)

214 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden

255 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden

215−

src/Language/PureScript.hs+6−23

@@ -14,8 +14,6 @@

14-----------------------------------------------------------------------------

16{-# LANGUAGE DataKinds #-}

17−{-# LANGUAGE QuasiQuotes #-}

18−{-# LANGUAGE TemplateHaskell #-}

19{-# LANGUAGE FlexibleContexts #-}

17{-# LANGUAGE FlexibleContexts #-}

20{-# LANGUAGE ScopedTypeVariables #-}

18{-# LANGUAGE ScopedTypeVariables #-}

@@ -34,7 +32,6 @@ import Data.List (sortBy, groupBy, intercalate)

34import Data.Maybe (fromMaybe)

32import Data.Maybe (fromMaybe)

35import Data.Time.Clock

33import Data.Time.Clock

36import Data.Version (Version)

34import Data.Version (Version)

37−import qualified Data.Traversable as T (traverse)

38import qualified Data.Map as M

35import qualified Data.Map as M

39import qualified Data.Set as S

36import qualified Data.Set as S

@@ -49,7 +46,7 @@ import System.FilePath ((</>))

50import Language.PureScript.AST as P

47import Language.PureScript.AST as P

51import Language.PureScript.Comments as P

48import Language.PureScript.Comments as P

52−import Language.PureScript.CodeGen as P

49+import Language.PureScript.CodeGen

53import Language.PureScript.DeadCodeElimination as P

50import Language.PureScript.DeadCodeElimination as P

54import Language.PureScript.Environment as P

51import Language.PureScript.Environment as P

55import Language.PureScript.Errors as P

52import Language.PureScript.Errors as P

@@ -90,12 +87,12 @@ import qualified Paths_purescript as Paths

90-- * Pretty-print the generated Javascript

87-- * Pretty-print the generated Javascript

91--

88--

92compile :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

89compile :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

93− => [Module] -> [String] -> m (String, String, Environment)

90+ => [Module] -> m ([CoreFn.Module CoreFn.Ann], String, Environment, Integer)

94compile = compile' initEnvironment

91compile = compile' initEnvironment

96compile' :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

93compile' :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

97− => Environment -> [Module] -> [String] -> m (String, String, Environment)

94+ => Environment -> [Module] -> m ([CoreFn.Module CoreFn.Ann], String, Environment, Integer)

98−compile' env ms prefix = do

95+compile' env ms = do

99 noPrelude <- asks optionsNoPrelude

96 noPrelude <- asks optionsNoPrelude

100 unless noPrelude (checkPreludeIsDefined ms)

97 unless noPrelude (checkPreludeIsDefined ms)

101 additional <- asks optionsAdditional

98 additional <- asks optionsAdditional

@@ -111,22 +108,8 @@ compile' env ms prefix = do

111 renamed = renameInModules elim

108 renamed = renameInModules elim

112 codeGenModuleNames = moduleNameFromString `map` codeGenModules additional

109 codeGenModuleNames = moduleNameFromString `map` codeGenModules additional

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

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

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

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

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

116− js' <- generateMain env' js

117− let pjs = unlines $ map ("// " ++) prefix ++ [prettyPrintJS js']

118− return (pjs, exts, env')

112+ return (modulesToCodeGen, exts, env', nextVar)

119−

120−generateMain :: (MonadError MultipleErrors m, MonadReader (Options Compile) m) => Environment -> [JS] -> m [JS]

121−generateMain env js = do

122− main <- asks optionsMain

123− additional <- asks optionsAdditional

124− case moduleNameFromString <$> main of

125− Just mmi -> do

126− when ((mmi, Ident C.main) `M.notMember` names env) $

127− throwError . errorMessage $ NameIsUndefined (Ident C.main)

128− return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar (browserNamespace additional)))) []]

129− _ -> return js

130

113

131-- |

114-- |

132-- A type class which collects the IO actions we need to be able to run in "make" mode

115-- A type class which collects the IO actions we need to be able to run in "make" mode

@@ -253,7 +236,7 @@ make outputDir ms prefix = do

253checkPreludeIsDefined :: (MonadWriter MultipleErrors m) => [Module] -> m ()

236checkPreludeIsDefined :: (MonadWriter MultipleErrors m) => [Module] -> m ()

254checkPreludeIsDefined ms = do

237checkPreludeIsDefined ms = do

255 let mns = map getModuleName ms

238 let mns = map getModuleName ms

256− unless (preludeModuleName `elem` mns) $

239+ unless (preludeModuleName `elem` mns) $

257 tell (errorMessage PreludeNotPresent)

240 tell (errorMessage PreludeNotPresent)

258

241

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

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

src/Language/PureScript/CodeGen/JS.hs+9−5

@@ -18,11 +18,12 @@

18{-# LANGUAGE FlexibleContexts #-}

19{-# LANGUAGE ScopedTypeVariables #-}

21−module Language.PureScript.CodeGen.JS (

21+module Language.PureScript.CodeGen.JS

22− module AST,

22+ ( module AST

23− module Common,

23+ , module Common

24− moduleToJs

24+ , moduleToJs

25+ , mainCall

25−) where

26+ ) where

27import Data.List ((\\), delete)

28import Data.List ((\\), delete)

28import Data.Maybe (mapMaybe)

29import Data.Maybe (mapMaybe)

@@ -352,3 +353,6 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do

352 done'' <- go done' (index + 1) bs'

353 done'' <- go done' (index + 1) bs'

353 js <- binderToJs elVar done'' binder

354 js <- binderToJs elVar done'' binder

354 return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)

355 return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)

356+

357+mainCall :: ModuleName -> String -> JS

358+mainCall mmi ns = JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar ns))) []