a909908 · rowtype-yoga/purescript-native

psc/Main.hs+7−7

compare with golang

unifiedsplit

@@ -86,9 +86,9 @@ magicDo :: Term Bool

86magicDo = value $ flag $ (optInfo [ "magic-do" ])

87 { optDoc = "Overload the do keyword to generate efficient code specifically for the Eff monad." }

88

89−runMain :: Term Bool

89+runMain :: Term (Maybe String)

90−runMain = value $ flag $ (optInfo [ "run-main" ])

90+runMain = value $ defaultOpt (Just "Main") Nothing $ (optInfo [ "main" ])

91− { optDoc = "Generate code to run the main method in the Main module." }

91+ { optDoc = "Generate code to run the main method in the specified module." }

92

93noOpts :: Term Bool

94noOpts = value $ flag $ (optInfo [ "no-opts" ])

@@ -98,12 +98,12 @@ browserNamespace :: Term String

98browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])

99 { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }

100

101−entryPoint :: Term (Maybe String)

101+dceModules :: Term [String]

102−entryPoint = value $ opt Nothing $ (optInfo [ "entry-point" ])

102+dceModules = value $ optAll [] $ (optInfo [ "m", "module" ])

103− { optDoc = "Specify the module which is the entry point. All code which is not a transitive dependency of this module will be removed." }

103+ { optDoc = "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." }

104

105options :: Term P.Options

106−options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts <*> browserNamespace <*> entryPoint

106+options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts <*> browserNamespace <*> dceModules

107

108stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])

109stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles

psci/Main.hs+1−1

@@ -35,7 +35,7 @@ getPreludeFilename :: IO FilePath

35getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"

36

37options :: P.Options

38−options = P.Options True False True True True "PS" Nothing

38+options = P.Options True False True Nothing True "PS" []

39

40completion :: [P.Module] -> CompletionFunc IO

41completion ms = completeWord Nothing " \t\n\r" findCompletions

src/Language/PureScript.hs+11−12

@@ -47,9 +47,9 @@ import qualified Data.Map as M

47--

48-- * Type check, and elaborate values to include type annotations and type class dictionaries.

49--

50−-- * Regroup values to take into account new value dependencies introduced by elaboration

50+-- * Regroup values to take into account new value dependencies introduced by elaboration.

51--

52−-- * Eliminate dead code

52+-- * Eliminate dead code.

53--

54-- * Generate Javascript, and perform optimization passes.

55--

@@ -63,17 +63,16 @@ compile opts ms = do

63 modify (\s -> s { checkCurrentModule = Just (ModuleName moduleName) })

64 Module moduleName <$> typeCheckAll mainModuleIdent (ModuleName moduleName) decls

65 regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated

66− let entryPoint = optionsEntryPoint opts <|> if (optionsRunMain opts) then Just "Main" else Nothing

66+ let entryPoints = optionsModules opts

67− let elim = maybe regrouped (\ep -> eliminateDeadCode env ep regrouped) entryPoint

67+ let elim = if null entryPoints then regrouped else eliminateDeadCode env entryPoints regrouped

68 let js = mapMaybe (flip (moduleToJs opts) env) elim

69 let exts = intercalate "\n" . map (flip moduleToPs env) $ elim

70− js' <- case () of

70+ js' <- case optionsMain opts of

71− _ | optionsRunMain opts -> do

71+ Just mainModuleName -> do

72− when ((mainModuleIdent, Ident "main") `M.notMember` (names env)) $

72+ when ((ModuleName (ProperName mainModuleName), Ident "main") `M.notMember` (names env)) $

73− Left $ mainModuleName ++ ".main is undefined"

73+ Left $ mainModuleName ++ ".main is undefined"

74− return $ js ++ [JSApp (JSAccessor "main" (JSAccessor mainModuleName (JSVar "_ps"))) []]

74+ return $ js ++ [JSApp (JSAccessor "main" (JSAccessor mainModuleName (JSVar "_ps"))) []]

75− | otherwise -> return js

75+ _ -> return js

76 return (prettyPrintJS [(wrapExportsContainer opts js')], exts, env)

77 where

78− mainModuleName = fromMaybe "Main" (optionsEntryPoint opts)

79− mainModuleIdent = ModuleName (ProperName mainModuleName)

78+ mainModuleIdent = ModuleName . ProperName <$> (optionsMain opts)

src/Language/PureScript/DeadCodeElimination.hs+3−3

@@ -30,11 +30,11 @@ import Language.PureScript.TypeChecker.Monad

30-- |

31-- Eliminate all declarations which are not a transitive dependency of the entry point module

32--

33−eliminateDeadCode :: Environment -> String -> [Module] -> [Module]

33+eliminateDeadCode :: Environment -> [String] -> [Module] -> [Module]

34−eliminateDeadCode env entryPoint ms =

34+eliminateDeadCode env entryPoints ms =

35 let declarations = concatMap (declarationsByModule env) ms

36 (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations

37− entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((ModuleName (ProperName mn), _), _) -> mn == entryPoint) $ 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)

39

40type Key = (ModuleName, Either Ident ProperName)

src/Language/PureScript/Options.hs+6−5

@@ -32,9 +32,10 @@ data Options = Options {

32 --

33 , optionsMagicDo :: Bool

34 -- |

35− -- Check the type of Main.main and generate its code

35+ -- When specified, checks the type of `main` in the module, and generate a call to run main

36+ -- after the module definitions.

36 --

37 --

37− , optionsRunMain :: Bool

38+ , optionsMain :: Maybe String

38 -- |

39 -- |

39 -- Skip all optimizations

40 -- Skip all optimizations

40 --

41 --

@@ -45,13 +46,13 @@ data Options = Options {

45 --

46 --

46 , optionsBrowserNamespace :: String

47 , optionsBrowserNamespace :: String

47 -- |

48 -- |

48− -- The entry point module, for dead code elimination

49+ -- The modules to keep while enabling dead code elimination

49 --

50 --

50− , optionsEntryPoint :: Maybe String

51+ , optionsModules :: [String]

51 } deriving Show

52 } deriving Show

52

53

53-- |

54-- |

54-- Default compiler options

55-- Default compiler options

55--

56--

56defaultOptions :: Options

57defaultOptions :: Options

57−defaultOptions = Options False False False False False "PS" Nothing

58+defaultOptions = Options False False False Nothing False "PS" []

src/Language/PureScript/TypeChecker.hs+1−1

@@ -111,7 +111,7 @@ checkTypeClassInstance _ _ = throwError "Type class instance must be of the form

111--

112-- * Process module imports

113--

114−typeCheckAll :: ModuleName -> ModuleName -> [Declaration] -> Check [Declaration]

114+typeCheckAll :: Maybe ModuleName -> ModuleName -> [Declaration] -> Check [Declaration]

115typeCheckAll _ _ [] = return []

116typeCheckAll mainModuleName moduleName (d@(DataDeclaration name args dctors) : rest) = do

117 rethrow (("Error in type constructor " ++ show name ++ ":\n") ++) $ do

src/Language/PureScript/TypeChecker/Types.hs+3−3

@@ -163,7 +163,7 @@ typeConstructorsAreEqual env moduleName = (==) `on` canonicalizeType moduleName

163-- Infer the types of multiple mutually-recursive values, and return elaborated values including

164-- type class dictionaries and type annotations.

165--

166−typesOf :: ModuleName -> ModuleName -> [(Ident, Value)] -> Check [(Ident, (Value, Type))]

166+typesOf :: Maybe ModuleName -> ModuleName -> [(Ident, Value)] -> Check [(Ident, (Value, Type))]

167typesOf mainModuleName moduleName vals = do

168 tys <- fmap tidyUp . liftUnify $ do

169 let

@@ -203,8 +203,8 @@ typesOf mainModuleName moduleName vals = do

203 TypedValue _ val' ty <- bindNames dict' $ infer val

204 ty =?= fromMaybe (error "name not found in dictionary") (lookup ident untypedDict)

205 return (ident, (TypedValue True val' ty, ty))

206− -- If run-main is enabled, need to check that Main.main has type Eff eff a for some eff, a

206+ -- If --main is enabled, need to check that `main` has type Eff eff a for some eff, a

207− when (moduleName == mainModuleName && fst e == Ident "main") $ do

207+ when (Just moduleName == mainModuleName && fst e == Ident "main") $ do

208 [eff, a] <- replicateM 2 fresh

209 ty =?= TypeApp (TypeApp (TypeConstructor (Qualified (Just (ModuleName (ProperName "Eff"))) (ProperName "Eff"))) eff) a

210 -- Make sure unification variables do not escape

tests/Main.hs+1−1

@@ -66,7 +66,7 @@ assertCompiles :: FilePath -> IO ()

66assertCompiles inputFile = do

67 putStrLn $ "assert " ++ inputFile ++ " compiles successfully"

68 prelude <- preludeFilename

69− assert (P.defaultOptions { P.optionsRunMain = True, P.optionsNoOptimizations = True, P.optionsEntryPoint = Just "Main" }) [prelude, inputFile] $ either (return . Just) $ \js -> do

69+ assert (P.defaultOptions { P.optionsMain = Just "Main", P.optionsNoOptimizations = True, P.optionsModules = ["Main"] }) [prelude, inputFile] $ either (return . Just) $ \js -> do

70 args <- getArgs

71 if "--run-js" `elem` args

72 then do