git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Remove psc, DCE module, simplify options.
12f585bPhil Freeman
psc-make/Main.hs+7−7
compare with golang
unifiedsplit
@@ -42,7 +42,7 @@ data PSCMakeOptions = PSCMakeOptions
42 { pscmInput :: [FilePath]
42 { pscmInput :: [FilePath]
43 , pscmForeignInput :: [FilePath]
43 , pscmForeignInput :: [FilePath]
44 , pscmOutputDir :: FilePath
44 , pscmOutputDir :: FilePath
45− , pscmOpts :: P.Options P.Make
45+ , pscmOpts :: P.Options
46 , pscmUsePrefix :: Bool
46 , pscmUsePrefix :: Bool
47 }
47 }
48
48
@@ -53,6 +53,9 @@ data InputOptions = InputOptions
53compile :: PSCMakeOptions -> IO ()
53compile :: PSCMakeOptions -> IO ()
54compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do
54compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do
55 input <- concat <$> mapM glob inputGlob
55 input <- concat <$> mapM glob inputGlob
56+ when (null input) $ do
57+ putStrLn "psc-make: No input files."
58+ exitFailure
56 moduleFiles <- readInput (InputOptions input)
59 moduleFiles <- readInput (InputOptions input)
57 inputForeign <- concat <$> mapM glob inputForeignGlob
60 inputForeign <- concat <$> mapM glob inputForeignGlob
58 foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
61 foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
@@ -145,18 +148,15 @@ noPrefix = switch $
145 <> help "Do not include comment header"
148 <> help "Do not include comment header"
146
149
147
150
148−options :: Parser (P.Options P.Make)
151+options :: Parser P.Options
149options = P.Options <$> noTco
152options = P.Options <$> noTco
150 <*> noMagicDo
153 <*> noMagicDo
151 <*> pure Nothing
154 <*> pure Nothing
152 <*> noOpts
155 <*> noOpts
153 <*> verboseErrors
156 <*> verboseErrors
154 <*> (not <$> comments)
157 <*> (not <$> comments)
155− <*> additionalOptions
156− where
157− additionalOptions =
158− P.MakeOptions <$> requirePath
158+ <*> requirePath
159−
159+
160pscMakeOptions :: Parser PSCMakeOptions
160pscMakeOptions :: Parser PSCMakeOptions
161pscMakeOptions = PSCMakeOptions <$> many inputFile
161pscMakeOptions = PSCMakeOptions <$> many inputFile
162 <*> many inputForeignFile
162 <*> many inputForeignFile
psc-make/Make.hs+3−3
@@ -46,10 +46,10 @@ import qualified Language.PureScript.CodeGen.JS as J
46import qualified Language.PureScript.CoreFn as CF
46import qualified Language.PureScript.CoreFn as CF
47import qualified Paths_purescript as Paths
47import qualified Paths_purescript as Paths
48
48
49−newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }
49+newtype Make a = Make { unMake :: ReaderT P.Options (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }
50− deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader (P.Options P.Make))
50+ deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader P.Options)
51
51
52−runMake :: P.Options P.Make -> Make a -> IO (Either P.MultipleErrors (a, P.MultipleErrors))
52+runMake :: P.Options -> Make a -> IO (Either P.MultipleErrors (a, P.MultipleErrors))
53runMake opts = runExceptT . runWriterT . flip runReaderT opts . unMake
53runMake opts = runExceptT . runWriterT . flip runReaderT opts . unMake
54
54
55makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
55makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
psc/Main.hsdeleted−231
@@ -1,231 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
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−{-# LANGUAGE DataKinds #-}
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE RecordWildCards #-}
18−{-# LANGUAGE ScopedTypeVariables #-}
19−{-# LANGUAGE TupleSections #-}
20−
21−module Main where
22−
23−import Control.Applicative
24−import Control.Monad
25−import Control.Monad.Error.Class (MonadError(..))
26−import Control.Monad.Reader
27−import Control.Monad.Writer
28−
29−import Data.Maybe (fromMaybe)
30−import Data.Version (showVersion)
31−
32−import Options.Applicative as Opts
33−
34−import System.Directory (createDirectoryIfMissing)
35−import System.Exit (exitSuccess, exitFailure)
36−import System.FilePath (takeDirectory)
37−import System.FilePath.Glob (glob)
38−import System.IO (hPutStrLn, stderr)
39−
40−import qualified Data.Map as M
41−import qualified Language.PureScript as P
42−import qualified Paths_purescript as Paths
43−
44−data PSCOptions = PSCOptions
45− { pscInput :: [FilePath]
46− , pscForeignInput :: [FilePath]
47− , pscOpts :: P.Options P.Compile
48− , pscStdIn :: Bool
49− , pscOutput :: Maybe FilePath
50− , pscExterns :: Maybe FilePath
51− , pscUsePrefix :: Bool
52− }
53−
54−data InputOptions = InputOptions
55− { ioUseStdIn :: Bool
56− , ioInputFiles :: [FilePath]
57− }
58−
59−readInput :: InputOptions -> IO [(Maybe FilePath, String)]
60−readInput InputOptions{..}
61− | ioUseStdIn = return . (Nothing ,) <$> getContents
62− | otherwise = forM ioInputFiles $ \inFile -> (Just inFile, ) <$> readFile inFile
63−
64−type PSC = ReaderT (P.Options P.Compile) (WriterT P.MultipleErrors (Either P.MultipleErrors))
65−
66−runPSC :: P.Options P.Compile -> PSC a -> Either P.MultipleErrors (a, P.MultipleErrors)
67−runPSC opts rwe = runWriterT (runReaderT rwe opts)
68−
69−compile :: PSCOptions -> IO ()
70−compile (PSCOptions inputGlob inputForeignGlob opts stdin output externs usePrefix) = do
71− let prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]
72− input <- concat <$> mapM glob inputGlob
73− moduleFiles <- readInput (InputOptions stdin input)
74− inputForeign <- concat <$> mapM glob inputForeignGlob
75− foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
76− case runWriterT (parseInputs moduleFiles foreignFiles) of
77− Left errs -> do
78− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
79− exitFailure
80− Right ((ms, foreigns), warnings) -> do
81− when (P.nonEmpty warnings) $
82− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
83− case runPSC opts (P.compileJS ms foreigns prefix) of
84− Left errs -> do
85− hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
86− exitFailure
87− Right ((js, exts, _), warnings') -> do
88− when (P.nonEmpty warnings') $
89− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
90− case output of
91− Just path -> mkdirp path >> writeFile path js
92− Nothing -> putStrLn js
93− case externs of
94− Just path -> mkdirp path >> writeFile path exts
95− Nothing -> return ()
96− exitSuccess
97−
98−parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
99− => [(Maybe FilePath, String)] -> [(FilePath, P.ForeignJS)] -> m ([P.Module], M.Map P.ModuleName (FilePath, P.ForeignJS))
100−parseInputs modules foreigns =
101− (,) <$> (map snd <$> P.parseModulesFromFiles (fromMaybe "") modules)
102− <*> P.parseForeignModulesFromFiles foreigns
103−
104−mkdirp :: FilePath -> IO ()
105−mkdirp = createDirectoryIfMissing True . takeDirectory
106−
107−codeGenModule :: Parser String
108−codeGenModule = strOption $
109− long "codegen"
110− <> help "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times."
111−
112−dceModule :: Parser String
113−dceModule = strOption $
114− short 'm'
115− <> long "module"
116− <> help "Enables dead code elimination, all code which is not a transitive dependency of a specified module will be removed. This argument can be used multiple times."
117−
118−browserNamespace :: Parser String
119−browserNamespace = strOption $
120− long "browser-namespace"
121− <> Opts.value "PS"
122− <> showDefault
123− <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
124−
125−verboseErrors :: Parser Bool
126−verboseErrors = switch $
127− short 'v'
128− <> long "verbose-errors"
129− <> help "Display verbose error messages"
130−
131−noOpts :: Parser Bool
132−noOpts = switch $
133− long "no-opts"
134− <> help "Skip the optimization phase."
135−
136−runMain :: Parser (Maybe String)
137−runMain = optional $ noArgs <|> withArgs
138− where
139− defaultVal = "Main"
140− noArgs = flag' defaultVal (long "main")
141− withArgs = strOption $
142− long "main"
143− <> help (concat [
144− "Generate code to run the main method in the specified module. ",
145− "(no argument: \"", defaultVal, "\")"
146− ])
147−
148−noMagicDo :: Parser Bool
149−noMagicDo = switch $
150− long "no-magic-do"
151− <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
152−
153−noTco :: Parser Bool
154−noTco = switch $
155− long "no-tco"
156− <> help "Disable tail call optimizations"
157−
158−comments :: Parser Bool
159−comments = switch $
160− short 'c'
161− <> long "comments"
162− <> help "Include comments in the generated code."
163−
164−useStdIn :: Parser Bool
165−useStdIn = switch $
166− short 's'
167− <> long "stdin"
168− <> help "Read from standard input"
169−
170−inputFile :: Parser FilePath
171−inputFile = strArgument $
172− metavar "FILE"
173− <> help "The input .purs file(s)"
174−
175−inputForeignFile :: Parser FilePath
176−inputForeignFile = strOption $
177− short 'f'
178− <> long "ffi"
179− <> help "The input .js file(s) providing foreign import implementations"
180−
181−outputFile :: Parser (Maybe FilePath)
182−outputFile = optional . strOption $
183− short 'o'
184− <> long "output"
185− <> help "The output .js file"
186−
187−externsFile :: Parser (Maybe FilePath)
188−externsFile = optional . strOption $
189− short 'e'
190− <> long "externs"
191− <> help "The output .e.purs file"
192−
193−noPrefix :: Parser Bool
194−noPrefix = switch $
195− short 'p'
196− <> long "no-prefix"
197− <> help "Do not include comment header"
198−
199−options :: Parser (P.Options P.Compile)
200−options = P.Options <$> noTco
201− <*> noMagicDo
202− <*> runMain
203− <*> noOpts
204− <*> verboseErrors
205− <*> (not <$> comments)
206− <*> additionalOptions
207− where
208− additionalOptions =
209− P.CompileOptions <$> browserNamespace
210− <*> many dceModule
211− <*> many codeGenModule
212−
213−pscOptions :: Parser PSCOptions
214−pscOptions = PSCOptions <$> many inputFile
215− <*> many inputForeignFile
216− <*> options
217− <*> useStdIn
218− <*> outputFile
219− <*> externsFile
220− <*> (not <$> noPrefix)
221−
222−main :: IO ()
223−main = execParser opts >>= compile
224− where
225− opts = info (version <*> helper <*> pscOptions) infoModList
226− infoModList = fullDesc <> headerInfo <> footerInfo
227− headerInfo = header "psc - Compiles PureScript to Javascript"
228− footerInfo = footer $ "psc " ++ showVersion Paths.version
229−
230− version :: Parser (a -> a)
231− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
psci/Make.hs+4−4
@@ -42,14 +42,14 @@ import qualified Language.PureScript.CoreFn as CF
42
42
43import IO (mkdirp)
43import IO (mkdirp)
44
44
45−options :: P.Options P.Make
45+options :: P.Options
46−options = P.Options False False Nothing False False False (P.MakeOptions Nothing)
46+options = P.Options False False Nothing False False False Nothing
47
47
48modulesDir :: FilePath
48modulesDir :: FilePath
49modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
49modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
50
50
51−newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }
51+newtype Make a = Make { unMake :: ReaderT P.Options (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }
52− deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader (P.Options P.Make))
52+ deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader P.Options)
53
53
54runMake :: Make a -> IO (Either P.MultipleErrors a)
54runMake :: Make a -> IO (Either P.MultipleErrors a)
55runMake = runExceptT . fmap fst . runWriterT . flip runReaderT options . unMake
55runMake = runExceptT . fmap fst . runWriterT . flip runReaderT options . unMake
purescript.cabal−11
@@ -78,7 +78,6 @@ library
78 Language.PureScript.CoreFn.Module
78 Language.PureScript.CoreFn.Module
79 Language.PureScript.CoreFn.Traversals
79 Language.PureScript.CoreFn.Traversals
80 Language.PureScript.Comments
80 Language.PureScript.Comments
81− Language.PureScript.DeadCodeElimination
82 Language.PureScript.Environment
81 Language.PureScript.Environment
83 Language.PureScript.Errors
82 Language.PureScript.Errors
84 Language.PureScript.Kinds
83 Language.PureScript.Kinds
@@ -145,16 +144,6 @@ library
145 other-modules: Paths_purescript
144 other-modules: Paths_purescript
146 ghc-options: -Wall -O2
145 ghc-options: -Wall -O2
147
146
148−executable psc
149− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
150− mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
151− transformers -any, Glob >= 0.7 && < 0.8
152− main-is: Main.hs
153− buildable: True
154− hs-source-dirs: psc
155− other-modules:
156− ghc-options: -Wall -O2 -fno-warn-unused-do-bind
157−
158executable psc-make
147executable psc-make
159 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
148 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
160 mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
149 mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
src/Language/PureScript.hs+3−94
@@ -20,9 +20,6 @@
20
20
21module Language.PureScript
21module Language.PureScript
22 ( module P
22 ( module P
23− , compile
24− , compile'
25− , compileJS
26 , RebuildPolicy(..)
23 , RebuildPolicy(..)
27 , MakeActions(..)
24 , MakeActions(..)
28 , SupplyVar()
25 , SupplyVar()
@@ -32,7 +29,7 @@ module Language.PureScript
32 ) where
29 ) where
33
30
34import Data.Function (on)
31import Data.Function (on)
35−import Data.List (sortBy, groupBy, intercalate)
32+import Data.List (sortBy, groupBy)
36import Data.Maybe (fromMaybe)
33import Data.Maybe (fromMaybe)
37import Data.Time.Clock
34import Data.Time.Clock
38import Data.Version (Version)
35import Data.Version (Version)
@@ -45,12 +42,11 @@ import Control.Monad
45import Control.Monad.Error.Class (MonadError(..))
42import Control.Monad.Error.Class (MonadError(..))
46import Control.Monad.Reader
43import Control.Monad.Reader
47import Control.Monad.Writer
44import Control.Monad.Writer
48−import Control.Monad.Supply.Class (MonadSupply, fresh)
45+import Control.Monad.Supply.Class (fresh)
49
46
50import Language.PureScript.AST as P
47import Language.PureScript.AST as P
51import Language.PureScript.Comments as P
48import Language.PureScript.Comments as P
52import Language.PureScript.CodeGen.Externs (moduleToPs)
49import Language.PureScript.CodeGen.Externs (moduleToPs)
53−import Language.PureScript.DeadCodeElimination as P
54import Language.PureScript.Environment as P
50import Language.PureScript.Environment as P
55import Language.PureScript.Errors as P
51import Language.PureScript.Errors as P
56import Language.PureScript.Kinds as P
52import Language.PureScript.Kinds as P
@@ -67,96 +63,9 @@ import Language.PureScript.TypeChecker as P
67import Language.PureScript.Types as P
63import Language.PureScript.Types as P
68import qualified Language.PureScript.CoreFn as CoreFn
64import qualified Language.PureScript.CoreFn as CoreFn
69import qualified Language.PureScript.Constants as C
65import qualified Language.PureScript.Constants as C
70−import qualified Language.PureScript.CodeGen.JS as J
71
66
72import qualified Paths_purescript as Paths
67import qualified Paths_purescript as Paths
73
68
74−-- |
75−-- Compile a collection of modules
76−--
77−-- The compilation pipeline proceeds as follows:
78−--
79−-- * Sort the modules based on module dependencies, checking for cyclic dependencies.
80−--
81−-- * Perform a set of desugaring passes.
82−--
83−-- * Type check, and elaborate values to include type annotations and type class dictionaries.
84−--
85−-- * Regroup values to take into account new value dependencies introduced by elaboration.
86−--
87−-- * Eliminate dead code.
88−--
89−-- * Generate Javascript, and perform optimization passes.
90−--
91−-- * Pretty-print the generated Javascript
92−--
93−compile :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)
94− => [Module] -> m ([CoreFn.Module CoreFn.Ann], Environment, SupplyVar, Externs)
95−compile = compile' initEnvironment
96−
97−compile' :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)
98− => Environment -> [Module] -> m ([CoreFn.Module CoreFn.Ann], Environment, SupplyVar, Externs)
99−compile' env ms = do
100− additional <- asks optionsAdditional
101− mainModuleIdent <- asks (fmap moduleNameFromString . optionsMain)
102− (sorted, _) <- sortModules $ map importPrim ms
103− mapM_ lint sorted
104− (desugared, nextVar) <- runSupplyT 0 $ desugar sorted
105− (elaborated, env') <- runCheck' env $ forM desugared $ typeCheckModule mainModuleIdent
106− regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
107− let corefn = map (CoreFn.moduleToCoreFn env') regrouped
108− entryPoints = moduleNameFromString `map` entryPointModules additional
109− elim = if null entryPoints then corefn else eliminateDeadCode entryPoints corefn
110− renamed = renameInModules elim
111− codeGenModuleNames = moduleNameFromString `map` codeGenModules additional
112− modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed
113− exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped
114− return (modulesToCodeGen, env', nextVar, exts)
115−
116−-- |
117−-- Compile a collection of modules to JavaScript and externs files
118−--
119−compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)
120− => [P.Module] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> [String] -> m (String, String, Environment)
121−compileJS ms foreigns prefix = do
122− (modulesToCodeGen, env, nextVar, exts) <- compile ms
123− js <- concat <$> evalSupplyT nextVar (P.parU modulesToCodeGen codegenModule)
124− js' <- generateMain env js
125− let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']
126− return (pjs, exts, env)
127−
128− where
129−
130− codegenModule :: (Functor n, Applicative n, MonadError P.MultipleErrors n, MonadWriter P.MultipleErrors n, MonadReader (P.Options P.Compile) n, MonadSupply n)
131− => CoreFn.Module CoreFn.Ann -> n [J.JS]
132− codegenModule m =
133− let requiresForeign = not $ null (CoreFn.moduleForeign m)
134− mn = CoreFn.moduleName m
135− in case mn `M.lookup` foreigns of
136− Just (path, js)
137− | not requiresForeign -> do
138− tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
139− J.moduleToJs m Nothing
140− | otherwise -> J.moduleToJs m $ Just $
141− J.JSApp (J.JSFunction Nothing [] $
142− J.JSBlock [ J.JSVariableIntroduction "exports" (Just $ J.JSObjectLiteral [])
143− , J.JSRaw js
144− , J.JSReturn (J.JSVar "exports")
145− ]) []
146− Nothing | requiresForeign -> throwError . P.errorMessage $ P.MissingFFIModule mn
147− | otherwise -> J.moduleToJs m Nothing
148−
149− generateMain :: P.Environment -> [J.JS] -> m [J.JS]
150− generateMain env js = do
151− mainName <- asks P.optionsMain
152− additional <- asks P.optionsAdditional
153− case P.moduleNameFromString <$> mainName of
154− Just mmi -> do
155− when ((mmi, P.Ident C.main) `M.notMember` P.names env) $
156− throwError . P.errorMessage $ P.NameIsUndefined (P.Ident C.main)
157− return $ js ++ [J.mainCall mmi (P.browserNamespace additional)]
158− _ -> return js
159−
160-- |
69-- |
161-- Actions that require implementations when running in "make" mode.
70-- Actions that require implementations when running in "make" mode.
162--
71--
@@ -212,7 +121,7 @@ data RebuildPolicy
212-- If timestamps have not changed, the externs file can be used to provide the module's types without
121-- If timestamps have not changed, the externs file can be used to provide the module's types without
213-- having to typecheck the module again.
122-- having to typecheck the module again.
214--
123--
215−make :: forall m. (Functor m, Applicative m, Monad m, MonadReader (P.Options P.Make) m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
124+make :: forall m. (Functor m, Applicative m, Monad m, MonadReader P.Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
216 => MakeActions m
125 => MakeActions m
217 -> [(Either RebuildPolicy FilePath, Module)]
126 -> [(Either RebuildPolicy FilePath, Module)]
218 -> m Environment
127 -> m Environment
src/Language/PureScript/CodeGen/JS.hs+4−16
@@ -50,14 +50,12 @@ import System.FilePath.Posix ((</>))
50-- Generate code in the simplified Javascript intermediate representation for all declarations in a
50-- Generate code in the simplified Javascript intermediate representation for all declarations in a
51-- module.
51-- module.
52--
52--
53−moduleToJs :: forall m mode. (Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m)
53+moduleToJs :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSupply m)
54 => Module Ann -> Maybe JS -> m [JS]
54 => Module Ann -> Maybe JS -> m [JS]
55moduleToJs (Module coms mn imps exps foreigns decls) foreign = do
55moduleToJs (Module coms mn imps exps foreigns decls) foreign = do
56− additional <- asks optionsAdditional
57 jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
56 jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
58 jsDecls <- mapM bindToJs decls
57 jsDecls <- mapM bindToJs decls
59 optimized <- T.traverse (T.traverse optimize) jsDecls
58 optimized <- T.traverse (T.traverse optimize) jsDecls
60− let isModuleEmpty = null exps
61 comments <- not <$> asks optionsNoComments
59 comments <- not <$> asks optionsNoComments
62 let strict = JSStringLiteral "use strict"
60 let strict = JSStringLiteral "use strict"
63 let header = if comments && not (null coms) then JSComment coms strict else strict
61 let header = if comments && not (null coms) then JSComment coms strict else strict
@@ -67,15 +65,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign = do
67 let standardExps = exps \\ foreignExps
65 let standardExps = exps \\ foreignExps
68 let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps
66 let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps
69 ++ map (runIdent &&& foreignIdent) foreignExps
67 ++ map (runIdent &&& foreignIdent) foreignExps
70− return $ case additional of
71− MakeOptions _ -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
68+ return $ moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
72− CompileOptions ns _ _ | not isModuleEmpty ->
73− [ JSVariableIntroduction ns
74− (Just (JSBinary Or (JSVar ns) (JSObjectLiteral [])) )
75− , JSAssignment (JSAccessor (moduleNameToJs mn) (JSVar ns))
76− (JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn exps']))) [])
77− ]
78− _ -> []
79
69
80 where
70 where
81
71
@@ -84,10 +74,8 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign = do
84 --
74 --
85 importToJs :: ModuleName -> m JS
75 importToJs :: ModuleName -> m JS
86 importToJs mn' = do
76 importToJs mn' = do
87− additional <- asks optionsAdditional
77+ path <- asks optionsRequirePath
88− let moduleBody = case additional of
89− MakeOptions path -> JSApp (JSVar "require") [JSStringLiteral (maybe id (</>) path $ runModuleName mn')]
78+ let moduleBody = JSApp (JSVar "require") [JSStringLiteral (maybe id (</>) path $ runModuleName mn')]
90− CompileOptions ns _ _ -> JSAccessor (moduleNameToJs mn') (JSVar ns)
91 return $ JSVariableIntroduction (moduleNameToJs mn') (Just moduleBody)
79 return $ JSVariableIntroduction (moduleNameToJs mn') (Just moduleBody)
92
80
93 -- |
81 -- |
src/Language/PureScript/CodeGen/JS/Optimizer.hs+2−2
@@ -55,12 +55,12 @@ import Language.PureScript.CodeGen.JS.Optimizer.Blocks
55-- |
55-- |
56-- Apply a series of optimizer passes to simplified Javascript code
56-- Apply a series of optimizer passes to simplified Javascript code
57--
57--
58−optimize :: (Monad m, MonadReader (Options mode) m, Applicative m, MonadSupply m) => JS -> m JS
58+optimize :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS
59optimize js = do
59optimize js = do
60 noOpt <- asks optionsNoOptimizations
60 noOpt <- asks optionsNoOptimizations
61 if noOpt then return js else optimize' js
61 if noOpt then return js else optimize' js
62
62
63−optimize' :: (Monad m, MonadReader (Options mode) m, Applicative m, MonadSupply m) => JS -> m JS
63+optimize' :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS
64optimize' js = do
64optimize' js = do
65 opts <- ask
65 opts <- ask
66 untilFixedPoint (inlineArrComposition . applyAll
66 untilFixedPoint (inlineArrComposition . applyAll
src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs+1−1
@@ -27,7 +27,7 @@ import Language.PureScript.Names
27import Language.PureScript.Options
27import Language.PureScript.Options
28import qualified Language.PureScript.Constants as C
28import qualified Language.PureScript.Constants as C
29
29
30−magicDo :: Options mode -> JS -> JS
30+magicDo :: Options -> JS -> JS
31magicDo opts | optionsNoMagicDo opts = id
31magicDo opts | optionsNoMagicDo opts = id
32 | otherwise = inlineST . magicDo'
32 | otherwise = inlineST . magicDo'
33
33
src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs+1−1
@@ -23,7 +23,7 @@ import Language.PureScript.CodeGen.JS.AST
23-- |
23-- |
24-- Eliminate tail calls
24-- Eliminate tail calls
25--
25--
26−tco :: Options mode -> JS -> JS
26+tco :: Options -> JS -> JS
27tco opts | optionsNoTco opts = id
27tco opts | optionsNoTco opts = id
28 | otherwise = tco'
28 | otherwise = tco'
29
29
src/Language/PureScript/DeadCodeElimination.hsdeleted−102
@@ -1,102 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.DeadCodeElimination
4−-- Copyright : (c) 2014 Phil Freeman
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Dead code elimination.
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.DeadCodeElimination (
16− eliminateDeadCode
17−) where
18−
19−import Data.Graph
20−import Data.List
21−import Data.Maybe (mapMaybe)
22−
23−import Language.PureScript.CoreFn
24−import Language.PureScript.Names
25−
26−-- |
27−-- Eliminate all declarations which are not a transitive dependency of the entry point module
28−--
29−eliminateDeadCode :: [ModuleName] -> [Module a] -> [Module a]
30−eliminateDeadCode entryPoints ms = map go ms
31− where
32− go (Module coms mn imps exps foreigns ds) = Module coms mn imps exps' foreigns' ds'
33− where
34− ds' = filter (isUsed mn graph vertexFor entryPointVertices) ds
35− foreigns' = filter (isUsed' mn graph vertexFor entryPointVertices . foreignIdent) foreigns
36− names = concatMap bindIdents ds' ++ map foreignIdent foreigns'
37− exps' = filter (`elem` names) exps
38− declarations = concatMap declarationsByModule ms
39− (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
40− entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
41−
42−-- |
43−-- Extract declaration names for a binding group.
44−--
45−bindIdents :: Bind a -> [Ident]
46−bindIdents (NonRec name _) = [name]
47−bindIdents (Rec names) = map fst names
48−
49−-- |
50−-- Extract the ident for a foreign declaration.
51−--
52−foreignIdent :: ForeignDecl -> Ident
53−foreignIdent = fst
54−
55−-- |
56−-- Key type to use in graph
57−--
58−type Key = (ModuleName, Ident)
59−
60−-- |
61−-- Find dependencies for each member in a module.
62−--
63−declarationsByModule :: Module a -> [(Key, [Key])]
64−declarationsByModule (Module _ mn _ _ fs ds) =
65− let fs' = map ((\name -> ((mn, name), [])) . foreignIdent) fs
66− in fs' ++ concatMap go ds
67− where
68− go :: Bind a -> [(Key, [Key])]
69− go d@(NonRec name _) = [((mn, name), dependencies d)]
70− go d@(Rec names') = map (\(name, _) -> ((mn, name), dependencies d)) names'
71−
72−-- |
73−-- Find all referenced values within a binding group.
74−--
75−dependencies :: Bind a -> [Key]
76−dependencies =
77− let (f, _, _, _) = everythingOnValues (++) (const []) values binders (const [])
78− in nub . f
79− where
80− values :: Expr a -> [Key]
81− values (Var _ (Qualified (Just mn) ident)) = [(mn, ident)]
82− values _ = []
83− binders :: Binder a -> [Key]
84− binders (ConstructorBinder _ _ (Qualified (Just mn) ident) _) = [(mn, Ident $ runProperName ident)]
85− binders _ = []
86−
87−-- |
88−-- Check whether a binding group is used.
89−--
90−isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Bind a -> Bool
91−isUsed mn graph vertexFor entryPointVertices (NonRec name _) =
92− isUsed' mn graph vertexFor entryPointVertices name
93−isUsed mn graph vertexFor entryPointVertices (Rec ds) =
94− any (isUsed' mn graph vertexFor entryPointVertices . fst) ds
95−
96−-- |
97−-- Check whether a named declaration is used.
98−--
99−isUsed' :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Ident -> Bool
100−isUsed' mn graph vertexFor entryPointVertices name =
101− let Just v' = vertexFor (mn, name)
102− in any (\v -> path graph v v') entryPointVertices
src/Language/PureScript/Options.hs+5−47
@@ -13,79 +13,37 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16−{-# LANGUAGE GADTs, DataKinds, StandaloneDeriving #-}
17−
18module Language.PureScript.Options where
16module Language.PureScript.Options where
19
17
20−-- |
21−-- Indicates the mode of the compiler. Lifted using DataKinds to refine the Options type.
22−--
23−data Mode = Compile | Make
24−
25−-- |
26−-- Per-mode options
27−--
28−data ModeOptions mode where
29− CompileOptions :: String -> [String] -> [String] -> ModeOptions Compile
30− MakeOptions :: Maybe FilePath -> ModeOptions Make
31−
32−browserNamespace :: ModeOptions Compile -> String
33−browserNamespace (CompileOptions ns _ _) = ns
34−
35−entryPointModules :: ModeOptions Compile -> [String]
36−entryPointModules (CompileOptions _ ms _) = ms
37−
38−codeGenModules :: ModeOptions Compile -> [String]
39−codeGenModules (CompileOptions _ _ ms) = ms
40−
41−requirePath :: ModeOptions Make -> Maybe FilePath
42−requirePath (MakeOptions mp) = mp
43−
44−deriving instance Show (ModeOptions mode)
45−
46-- |
18-- |
47-- The data type of compiler options
19-- The data type of compiler options
48--
20--
49−data Options mode = Options {
21+data Options = Options {
50 -- |
22 -- |
51 -- Disable tail-call elimination
23 -- Disable tail-call elimination
52− --
53 optionsNoTco :: Bool
24 optionsNoTco :: Bool
54 -- |
25 -- |
55 -- Disable inlining of calls to return and bind for the Eff monad
26 -- Disable inlining of calls to return and bind for the Eff monad
56− --
57 , optionsNoMagicDo :: Bool
27 , optionsNoMagicDo :: Bool
58 -- |
28 -- |
59 -- When specified, checks the type of `main` in the module, and generate a call to run main
29 -- When specified, checks the type of `main` in the module, and generate a call to run main
60 -- after the module definitions.
30 -- after the module definitions.
61− --
62 , optionsMain :: Maybe String
31 , optionsMain :: Maybe String
63 -- |
32 -- |
64 -- Skip all optimizations
33 -- Skip all optimizations
65− --
66 , optionsNoOptimizations :: Bool
34 , optionsNoOptimizations :: Bool
67 -- |
35 -- |
68 -- Verbose error message
36 -- Verbose error message
69− --
70 , optionsVerboseErrors :: Bool
37 , optionsVerboseErrors :: Bool
71 -- |
38 -- |
72 -- Remove the comments from the generated js
39 -- Remove the comments from the generated js
73 , optionsNoComments :: Bool
40 , optionsNoComments :: Bool
74 -- |
41 -- |
75− -- Specify the namespace that PureScript modules will be exported to when running in the
42+ -- The path to prepend to require statements
76− -- browser.
43+ , optionsRequirePath :: Maybe FilePath
77− --
78− , optionsAdditional :: ModeOptions mode
79 } deriving Show
44 } deriving Show
80
45
81−-- |
82−-- Default compiler options
83−--
84−defaultCompileOptions :: Options Compile
85−defaultCompileOptions = Options False False Nothing False False False (CompileOptions "PS" [] [])
86−
87-- |
46-- |
88-- Default make options
47-- Default make options
89−--
48+defaultOptions :: Options
90−defaultMakeOptions :: Options Make
91−defaultMakeOptions = Options False False Nothing False False False (MakeOptions Nothing)
49+defaultOptions = Options False False Nothing False False False Nothing
src/Language/PureScript/TypeChecker/Entailment.hs+1−1
@@ -21,7 +21,7 @@ module Language.PureScript.TypeChecker.Entailment (
21
21
22import Data.Function (on)
22import Data.Function (on)
23import Data.List
23import Data.List
24−import Data.Maybe (fromMaybe, maybeToList)
24+import Data.Maybe (maybeToList)
25import Data.Foldable (foldMap)
25import Data.Foldable (foldMap)
26import qualified Data.Map as M
26import qualified Data.Map as M
27
27
src/Language/PureScript/TypeChecker/Synonyms.hs−1
@@ -28,7 +28,6 @@ import Data.Maybe (fromMaybe)
28import qualified Data.Map as M
28import qualified Data.Map as M
29
29
30import Control.Applicative
30import Control.Applicative
31−import Control.Monad
32import Control.Monad.Error.Class (MonadError(..))
31import Control.Monad.Error.Class (MonadError(..))
33import Control.Monad.State
32import Control.Monad.State
34
33