b39c400 · rowtype-yoga/purescript-native

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

Fix #580

commitb39c400125a0e970ac39bdddeb2cd85cd5f6a98c authorPhil Freeman <paf31@cantab.net> dateWed 17 Sep 2014, 10:52 (12 years ago) parent79fcdf4

11 files changed+114−86

compare with golang

unifiedsplit

psc-make/Main.hs+6−5 psc/Main.hs+8−5 psci/Main.hs+8−8 src/Language/PureScript.hs+14−12 src/Language/PureScript/CodeGen/JS.hs+23−27 src/Language/PureScript/Optimizer.hs+1−1 src/Language/PureScript/Optimizer/MagicDo.hs+1−1 src/Language/PureScript/Optimizer/TCO.hs+1−1 src/Language/PureScript/Options.hs+39−17 src/Language/PureScript/TypeChecker/Monad.hs+2−2 tests/Main.hs+11−7

psc-make/Main.hs+6−5

@@ -12,7 +12,7 @@

1212--

1313-----------------------------------------------------------------------------

1414

15−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

15+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving #-}

1616

1717module Main where

1818

@@ -66,7 +66,7 @@ instance P.MonadMake Make where

6666 liftError = either throwError return

6767 progress = makeIO . U.putStrLn

6868

69−compile :: FilePath -> [FilePath] -> FilePath -> P.Options -> Bool -> IO ()

69+compile :: FilePath -> [FilePath] -> FilePath -> P.Options P.Make -> Bool -> IO ()

7070compile prelude input outputDir opts usePrefix = do

7171 modules <- readInput allInputFiles

7272 case modules of

@@ -81,7 +81,7 @@ compile prelude input outputDir opts usePrefix = do

8181 exitFailure

8282 Right _ -> do

8383 exitSuccess

84− where

84+ where

8585 prefix = if usePrefix

8686 then ["Generated by psc-make version " ++ showVersion Paths.version]

8787 else []

@@ -124,8 +124,8 @@ verboseErrors :: Term Bool

124124verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])

125125 { optDoc = "Display verbose error messages" }

126126

127−options :: Term P.Options

128−options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> pure Nothing <*> noOpts <*> pure Nothing <*> pure [] <*> pure [] <*> verboseErrors

127+options :: Term (P.Options P.Make)

128+options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> pure Nothing <*> noOpts <*> verboseErrors <*> pure P.MakeOptions

129129

130130noPrefix :: Term Bool

131131noPrefix = value $ flag $ (optInfo ["p", "no-prefix" ])

@@ -145,3 +145,4 @@ main :: IO ()

145145main = do

146146 prelude <- P.preludeFilename

147147 run (term prelude, termInfo)

148+

psc/Main.hs+8−5

@@ -12,7 +12,7 @@

1212--

1313-----------------------------------------------------------------------------

1414

15−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

15+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving #-}

1616

1717module Main where

1818

@@ -44,7 +44,7 @@ readInput (Just input) = fmap collect $ forM input $ \inputFile -> do

4444 collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]

4545 collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)

4646

47−compile :: FilePath -> P.Options -> Bool -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Bool -> IO ()

47+compile :: FilePath -> P.Options P.Compile -> Bool -> [FilePath] -> Maybe FilePath -> Maybe FilePath -> Bool -> IO ()

4848compile prelude opts stdin input output externs usePrefix = do

4949 modules <- readInput stdInOrInputFiles

5050 case modules of

@@ -70,7 +70,7 @@ compile prelude opts stdin input output externs usePrefix = do

7070 | P.optionsNoPrelude opts = Just input

7171 | otherwise = Just $ prelude : input

7272 prefix = if usePrefix

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

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

7474 else []

7575

7676mkdirp :: FilePath -> IO ()

@@ -136,8 +136,10 @@ noPrefix :: Term Bool

136136noPrefix = value $ flag $ (optInfo ["no-prefix" ])

137137 { optDoc = "Do not include comment header"}

138138

139−options :: Term P.Options

140−options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> runMain <*> noOpts <*> (Just <$> browserNamespace) <*> dceModules <*> codeGenModules <*> verboseErrors

139+options :: Term (P.Options P.Compile)

140+options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> runMain <*> noOpts <*> verboseErrors <*> additionalOptions

141+ where

142+ additionalOptions = P.CompileOptions <$> browserNamespace <*> dceModules <*> codeGenModules

141143

142144term :: FilePath -> Term (IO ())

143145term prelude = compile prelude <$> options <*> useStdIn <*> inputFiles <*> outputFile <*> externsFile <*> (not <$> noPrefix)

@@ -154,3 +156,4 @@ main = do

154156 prelude <- P.preludeFilename

155157 run (term prelude, termInfo)

156158

159+

psci/Main.hs+8−8

@@ -13,7 +13,7 @@

1313--

1414-----------------------------------------------------------------------------

1515

16−{-# LANGUAGE DoAndIfThenElse, FlexibleContexts, GeneralizedNewtypeDeriving #-}

16+{-# LANGUAGE DataKinds, DoAndIfThenElse, FlexibleContexts, GeneralizedNewtypeDeriving #-}

1717

1818module Main where

1919

@@ -198,8 +198,8 @@ completion = completeWord Nothing " \t\n\r" findCompletions

198198

199199-- | Compilation options.

200200--

201−options :: P.Options

202−options = P.Options False False False False Nothing False Nothing [] [] False

201+options :: P.Options P.Make

202+options = P.Options False False False False Nothing False False P.MakeOptions

203203

204204-- |

205205-- PSCI monad

@@ -276,7 +276,7 @@ handleDeclaration :: P.Expr -> PSCI ()

276276handleDeclaration value = do

277277 st <- PSCI $ lift get

278278 let m = createTemporaryModule True st value

279− e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []

279+ e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []

280280 case e of

281281 Left err -> PSCI $ outputStrLn err

282282 Right _ -> do

@@ -295,7 +295,7 @@ handleTypeOf :: P.Expr -> PSCI ()

295295handleTypeOf value = do

296296 st <- PSCI $ lift get

297297 let m = createTemporaryModule False st value

298− e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []

298+ e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []

299299 case e of

300300 Left err -> PSCI $ outputStrLn err

301301 Right env' ->

@@ -311,7 +311,7 @@ handleKindOf typ = do

311311 st <- PSCI $ lift get

312312 let m = createTemporaryModuleForKind st typ

313313 mName = P.ModuleName [P.ProperName "$PSCI"]

314− e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []

314+ e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)]) []

315315 case e of

316316 Left err -> PSCI $ outputStrLn err

317317 Right env' ->

@@ -374,12 +374,12 @@ handleCommand _ = PSCI $ outputStrLn "Unknown command"

374374singleLineFlag :: Cmd.Term Bool

375375singleLineFlag = Cmd.value $ Cmd.flag $ (Cmd.optInfo ["single-line-mode"])

376376 { Cmd.optName = "Single-line mode"

377− , Cmd.optDoc = "Run in single-line mode"

377+ , Cmd.optDoc = "Run in single-line mode"

378378 }

379379

380380inputFiles :: Cmd.Term [FilePath]

381381inputFiles = Cmd.value $ Cmd.posAny [] $ Cmd.posInfo { Cmd.posName = "file(s)"

382− , Cmd.posDoc = "Optional .purs files to load on start"

382+ , Cmd.posDoc = "Optional .purs files to load on start"

383383 }

384384

385385loadUserConfig :: IO (Maybe [Command])

src/Language/PureScript.hs+14−12

@@ -13,6 +13,8 @@

1313--

1414-----------------------------------------------------------------------------

1515

16+{-# LANGUAGE DataKinds #-}

17+

1618module Language.PureScript (module P, compile, compile', MonadMake(..), make, preludeFilename) where

1719

1820import Language.PureScript.Types as P

@@ -39,7 +41,7 @@ import qualified Paths_purescript as Paths

3941import Data.List (find, sortBy, groupBy, intercalate)

4042import Data.Time.Clock

4143import Data.Function (on)

42−import Data.Maybe (fromJust, fromMaybe)

44+import Data.Maybe (fromMaybe)

4345import Control.Monad.Error

4446import Control.Monad.State.Lazy

4547import Control.Arrow ((&&&))

@@ -67,21 +69,21 @@ import System.FilePath (pathSeparator)

6769--

6870-- * Pretty-print the generated Javascript

6971--

70−compile :: Options -> [Module] -> [String] -> Either String (String, String, Environment)

72+compile :: Options Compile -> [Module] -> [String] -> Either String (String, String, Environment)

7173compile = compile' initEnvironment

7274

73−compile' :: Environment -> Options -> [Module] -> [String] -> Either String (String, String, Environment)

75+compile' :: Environment -> Options Compile -> [Module] -> [String] -> Either String (String, String, Environment)

7476compile' env opts ms prefix = do

7577 (sorted, _) <- sortModules $ map importPrim $ if optionsNoPrelude opts then ms else (map importPrelude ms)

7678 (desugared, nextVar) <- stringifyErrorStack True $ runSupplyT 0 $ desugar sorted

7779 (elaborated, env') <- runCheck' opts env $ forM desugared $ typeCheckModule mainModuleIdent

7880 regrouped <- stringifyErrorStack True $ createBindingGroupsModule . collapseBindingGroupsModule $ elaborated

79− let entryPoints = moduleNameFromString `map` optionsModules opts

81+ let entryPoints = moduleNameFromString `map` entryPointModules (optionsAdditional opts)

8082 let elim = if null entryPoints then regrouped else eliminateDeadCode entryPoints regrouped

8183 let renamed = renameInModules elim

82− let codeGenModules = moduleNameFromString `map` optionsCodeGenModules opts

83− let modulesToCodeGen = if null codeGenModules then renamed else filter (\(Module mn _ _) -> mn `elem` codeGenModules) renamed

84− let js = evalSupply nextVar $ concat <$> mapM (\m -> moduleToJs Globals opts m env') modulesToCodeGen

84+ let codeGenModuleNames = moduleNameFromString `map` codeGenModules (optionsAdditional opts)

85+ let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(Module mn _ _) -> mn `elem` codeGenModuleNames) renamed

86+ let js = evalSupply nextVar $ concat <$> mapM (\m -> moduleToJs opts m env') modulesToCodeGen

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

8688 js' <- generateMain env' opts js

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

@@ -126,13 +128,13 @@ typeCheckModule mainModuleName (Module mn decls exps) = do

126128 go _ = True

127129

128130

129−generateMain :: Environment -> Options -> [JS] -> Either String [JS]

131+generateMain :: Environment -> Options Compile -> [JS] -> Either String [JS]

130132generateMain env opts js =

131133 case moduleNameFromString <$> optionsMain opts of

132134 Just mmi -> do

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

134136 Left $ show mmi ++ "." ++ C.main ++ " is undefined"

135− return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar (fromJust (optionsBrowserNamespace opts))))) []]

137+ return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar (browserNamespace (optionsAdditional opts))))) []]

136138 _ -> return js

137139

138140-- |

@@ -170,7 +172,7 @@ class MonadMake m where

170172-- If timestamps have not changed, the externs file can be used to provide the module's types without

171173-- having to typecheck the module again.

172174--

173−make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options -> [(FilePath, Module)] -> [String] -> m Environment

175+make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options Make -> [(FilePath, Module)] -> [String] -> m Environment

174176make outputDir opts ms prefix = do

175177 let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)

176178

@@ -216,9 +218,9 @@ make outputDir opts ms prefix = do

216218 regrouped <- lift . liftError . stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated

217219

218220 let mod' = Module moduleName' regrouped exps

219− let [renamed] = renameInModules [mod']

221+ let [renamed] = renameInModules [mod']

220222

221− pjs <- prettyPrintJS <$> moduleToJs CommonJS opts renamed env'

223+ pjs <- prettyPrintJS <$> moduleToJs opts renamed env'

222224 let js = unlines $ map ("// " ++) prefix ++ [pjs]

223225 let exts = unlines $ map ("-- " ++ ) prefix ++ [moduleToPs renamed env']

224226

src/Language/PureScript/CodeGen/JS.hs+23−27

@@ -13,17 +13,16 @@

1313--

1414-----------------------------------------------------------------------------

1515

16−{-# LANGUAGE DoAndIfThenElse #-}

16+{-# LANGUAGE GADTs, DoAndIfThenElse #-}

1717

1818module Language.PureScript.CodeGen.JS (

1919 module AST,

20− ModuleType(..),

2120 declToJs,

2221 moduleToJs,

2322 identNeedsEscaping

2423) where

2524

26−import Data.Maybe (catMaybes, fromJust)

25+import Data.Maybe (catMaybes)

2726import Data.Function (on)

2827import Data.List (nub, (\\), delete, sortBy)

2928

@@ -42,40 +41,36 @@ import Language.PureScript.Supply

4241import Language.PureScript.Traversals (sndM)

4342import qualified Language.PureScript.Constants as C

4443

45−-- |

46−-- Different types of modules which are supported

47−--

48−data ModuleType = CommonJS | Globals

49−

5044-- |

5145-- Generate code in the simplified Javascript intermediate representation for all declarations in a

5246-- module.

5347--

54−moduleToJs :: (Functor m, Applicative m, Monad m) => ModuleType -> Options -> Module -> Environment -> SupplyT m [JS]

55−moduleToJs mt opts (Module name decls (Just exps)) env = do

56− let jsImports = map (importToJs mt opts) . delete (ModuleName [ProperName C.prim]) . (\\ [name]) . nub $ concatMap imports decls

48+moduleToJs :: (Functor m, Applicative m, Monad m) => Options mode -> Module -> Environment -> SupplyT m [JS]

49+moduleToJs opts (Module name decls (Just exps)) env = do

50+ let jsImports = map (importToJs opts) . delete (ModuleName [ProperName C.prim]) . (\\ [name]) . nub $ concatMap imports decls

5751 jsDecls <- mapM (\decl -> declToJs opts name decl env) decls

5852 let optimized = concat $ map (map $ optimize opts) $ catMaybes jsDecls

5953 let isModuleEmpty = null exps

6054 let moduleBody = JSStringLiteral "use strict" : jsImports ++ optimized

6155 let moduleExports = JSObjectLiteral $ concatMap exportToJs exps

62− return $ case mt of

63− CommonJS -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) moduleExports]

64− Globals | not isModuleEmpty ->

65− [ JSVariableIntroduction (fromJust (optionsBrowserNamespace opts))

66− (Just (JSBinary Or (JSVar (fromJust (optionsBrowserNamespace opts))) (JSObjectLiteral [])) )

67− , JSAssignment (JSAccessor (moduleNameToJs name) (JSVar (fromJust (optionsBrowserNamespace opts))))

56+ return $ case optionsAdditional opts of

57+ MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) moduleExports]

58+ CompileOptions ns _ _ | not isModuleEmpty ->

59+ [ JSVariableIntroduction ns

60+ (Just (JSBinary Or (JSVar ns) (JSObjectLiteral [])) )

61+ , JSAssignment (JSAccessor (moduleNameToJs name) (JSVar ns))

6862 (JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn moduleExports]))) [])

6963 ]

7064 _ -> []

71−moduleToJs _ _ _ _ = error "Exports should have been elaborated in name desugaring"

65+moduleToJs _ _ _ = error "Exports should have been elaborated in name desugaring"

7266

73−importToJs :: ModuleType -> Options -> ModuleName -> JS

74−importToJs mt opts mn = JSVariableIntroduction (moduleNameToJs mn) (Just moduleBody)

67+importToJs :: Options mode -> ModuleName -> JS

68+importToJs opts mn =

69+ JSVariableIntroduction (moduleNameToJs mn) (Just moduleBody)

7570 where

76− moduleBody = case mt of

77− CommonJS -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn)]

78− Globals -> JSAccessor (moduleNameToJs mn) (JSVar (fromJust (optionsBrowserNamespace opts)))

71+ moduleBody = case optionsAdditional opts of

72+ MakeOptions -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn)]

73+ CompileOptions ns _ _ -> JSAccessor (moduleNameToJs mn) (JSVar ns)

7974

8075imports :: Declaration -> [ModuleName]

8176imports (ImportDeclaration mn _ _) = [mn]

@@ -95,7 +90,7 @@ imports other =

9590-- |

9691-- Generate code in the simplified Javascript intermediate representation for a declaration

9792--

98−declToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> Declaration -> Environment -> SupplyT m (Maybe [JS])

93+declToJs :: (Functor m, Applicative m, Monad m) => Options mode -> ModuleName -> Declaration -> Environment -> SupplyT m (Maybe [JS])

9994declToJs opts mp (ValueDeclaration ident _ _ _ val) e = do

10095 js <- valueToJs opts mp e val

10196 return $ Just [JSVariableIntroduction (identToJs ident) (Just js)]

@@ -190,7 +185,7 @@ accessorString prop | identNeedsEscaping prop = JSIndexer (JSStringLiteral prop)

190185-- |

191186-- Generate code in the simplified Javascript intermediate representation for a value or expression.

192187--

193−valueToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> Environment -> Expr -> SupplyT m JS

188+valueToJs :: (Functor m, Applicative m, Monad m) => Options mode -> ModuleName -> Environment -> Expr -> SupplyT m JS

194189valueToJs _ _ _ (NumericLiteral n) = return $ JSNumericLiteral n

195190valueToJs _ _ _ (StringLiteral s) = return $ JSStringLiteral s

196191valueToJs _ _ _ (BooleanLiteral b) = return $ JSBooleanLiteral b

@@ -315,7 +310,7 @@ qualifiedToJS _ f (Qualified _ a) = JSVar $ identToJs (f a)

315310-- Generate code in the simplified Javascript intermediate representation for pattern match binders

316311-- and guards.

317312--

318−bindersToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> Environment -> [CaseAlternative] -> [JS] -> SupplyT m JS

313+bindersToJs :: (Functor m, Applicative m, Monad m) => Options mode -> ModuleName -> Environment -> [CaseAlternative] -> [JS] -> SupplyT m JS

319314bindersToJs opts m e binders vals = do

320315 valNames <- replicateM (length vals) freshName

321316 let assignments = zipWith JSVariableIntroduction valNames (map Just vals)

@@ -405,7 +400,7 @@ binderToJs m e varName done binder@(ConsBinder _ _) = do

405400 ( JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left numberOfHeadBinders)])) :

406401 js2

407402 )) Nothing]

408− where

403+ where

409404 uncons :: [Binder] -> Binder -> ([Binder], Binder)

410405 uncons acc (ConsBinder h t) = uncons (h : acc) t

411406 uncons acc (PositionedBinder _ b) = uncons acc b

@@ -416,3 +411,4 @@ binderToJs m e varName done (NamedBinder ident binder) = do

416411binderToJs m e varName done (PositionedBinder _ binder) =

417412 binderToJs m e varName done binder

418413

414+

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

@@ -49,7 +49,7 @@ import Language.PureScript.Optimizer.Blocks

4949-- |

5050-- Apply a series of optimizer passes to simplified Javascript code

5151--

52−optimize :: Options -> JS -> JS

52+optimize :: Options mode -> JS -> JS

5353optimize opts | optionsNoOptimizations opts = id

5454 | otherwise = untilFixedPoint (applyAll

5555 [ collapseNestedBlocks

src/Language/PureScript/Optimizer/MagicDo.hs+1−1

@@ -28,7 +28,7 @@ import Language.PureScript.Names

2828

2929import qualified Language.PureScript.Constants as C

3030

31−magicDo :: Options -> JS -> JS

31+magicDo :: Options mode -> JS -> JS

3232magicDo opts | optionsNoMagicDo opts = id

3333 | otherwise = inlineST . magicDo'

3434

src/Language/PureScript/Optimizer/TCO.hs+1−1

@@ -21,7 +21,7 @@ import Language.PureScript.CodeGen.JS.AST

2121-- |

2222-- Eliminate tail calls

2323--

24−tco :: Options -> JS -> JS

24+tco :: Options mode -> JS -> JS

2525tco opts | optionsNoTco opts = id

2626 | otherwise = tco'

2727

src/Language/PureScript/Options.hs+39−17

@@ -13,12 +13,37 @@

1313--

1414-----------------------------------------------------------------------------

1515

16+{-# LANGUAGE GADTs, DataKinds, StandaloneDeriving #-}

17+

1618module Language.PureScript.Options where

1719

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 :: 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+deriving instance Show (ModeOptions mode)

42+

1843-- |

1944-- The data type of compiler options

2045--

21−data Options = Options {

46+data Options mode = Options {

2247 -- |

2348 -- Disable inclusion of the built in Prelude

2449 --

@@ -44,28 +69,25 @@ data Options = Options {

4469 -- Skip all optimizations

4570 --

4671 , optionsNoOptimizations :: Bool

47− -- |

48− -- Specify the namespace that PureScript modules will be exported to when running in the

49− -- browser.

50− --

51− , optionsBrowserNamespace :: Maybe String

52− -- |

53− -- The modules to keep while enabling dead code elimination

54− --

55− , optionsModules :: [String]

56− -- |

57− -- The modules to code gen

58− --

59− , optionsCodeGenModules :: [String]

6072 -- |

6173 -- Verbose error message

6274 --

6375 , optionsVerboseErrors :: Bool

64−

76+ -- |

77+ -- Specify the namespace that PureScript modules will be exported to when running in the

78+ -- browser.

79+ --

80+ , optionsAdditional :: ModeOptions mode

6581 } deriving Show

6682

6783-- |

6884-- Default compiler options

6985--

70−defaultOptions :: Options

71−defaultOptions = Options False False False False Nothing False Nothing [] [] False

86+defaultCompileOptions :: Options Compile

87+defaultCompileOptions = Options False False False False Nothing False False (CompileOptions "PS" [] [])

88+

89+-- |

90+-- Default make options

91+--

92+defaultMakeOptions :: Options Make

93+defaultMakeOptions = Options False False False False Nothing False False MakeOptions

src/Language/PureScript/TypeChecker/Monad.hs+2−2

@@ -190,13 +190,13 @@ modifyEnv f = modify (\s -> s { checkEnv = f (checkEnv s) })

190190-- |

191191-- Run a computation in the Check monad, starting with an empty @Environment@

192192--

193−runCheck :: Options -> Check a -> Either String (a, Environment)

193+runCheck :: Options mode -> Check a -> Either String (a, Environment)

194194runCheck opts = runCheck' opts initEnvironment

195195

196196-- |

197197-- Run a computation in the Check monad, failing with an error, or succeeding with a return value and the final @Environment@.

198198--

199−runCheck' :: Options -> Environment -> Check a -> Either String (a, Environment)

199+runCheck' :: Options mode -> Environment -> Check a -> Either String (a, Environment)

200200runCheck' opts env c = stringifyErrorStack (optionsVerboseErrors opts) $ do

201201 (a, s) <- flip runStateT (CheckState env 0 0 Nothing) $ unCheck c

202202 return (a, checkEnv s)

tests/Main.hs+11−7

@@ -12,7 +12,7 @@

1212--

1313-----------------------------------------------------------------------------

1414

15−{-# LANGUAGE DoAndIfThenElse #-}

15+{-# LANGUAGE DataKinds, DoAndIfThenElse #-}

1616

1717module Main (main) where

1818

@@ -34,15 +34,15 @@ readInput inputFiles = fmap (fmap concat . sequence) $ forM inputFiles $ \inputF

3434 text <- U.readFile inputFile

3535 return $ P.runIndentParser inputFile P.parseModules text

3636

37−compile :: P.Options -> [FilePath] -> IO (Either String (String, String, P.Environment))

37+compile :: P.Options P.Compile -> [FilePath] -> IO (Either String (String, String, P.Environment))

3838compile opts inputFiles = do

3939 modules <- readInput inputFiles

4040 case modules of

4141 Left parseError ->

4242 return (Left $ show parseError)

43− Right ms -> return $ P.compile opts ms []

43+ Right ms -> return $ P.compile opts ms []

4444

45−assert :: FilePath -> P.Options -> FilePath -> (Either String (String, String, P.Environment) -> IO (Maybe String)) -> IO ()

45+assert :: FilePath -> P.Options P.Compile -> FilePath -> (Either String (String, String, P.Environment) -> IO (Maybe String)) -> IO ()

4646assert preludeExterns opts inputFile f = do

4747 e <- compile opts [preludeExterns, inputFile]

4848 maybeErr <- f e

@@ -53,7 +53,10 @@ assert preludeExterns opts inputFile f = do

5353assertCompiles :: String -> FilePath -> FilePath -> IO ()

5454assertCompiles preludeJs preludeExterns inputFile = do

5555 putStrLn $ "Assert " ++ inputFile ++ " compiles successfully"

56− let options = P.defaultOptions { P.optionsMain = Just "Main", P.optionsModules = ["Main"], P.optionsCodeGenModules = ["Main"], P.optionsBrowserNamespace = Just "Tests" }

56+ let options = P.defaultCompileOptions

57+ { P.optionsMain = Just "Main"

58+ , P.optionsAdditional = P.CompileOptions "Tests" ["Main"] ["Main"]

59+ }

5760 assert preludeExterns options inputFile $ either (return . Just) $ \(js, _, _) -> do

5861 process <- findNodeProcess

5962 result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process

@@ -65,7 +68,7 @@ assertCompiles preludeJs preludeExterns inputFile = do

6568assertDoesNotCompile :: FilePath -> FilePath -> IO ()

6669assertDoesNotCompile preludeExterns inputFile = do

6770 putStrLn $ "Assert " ++ inputFile ++ " does not compile"

68− assert preludeExterns (P.defaultOptions { P.optionsBrowserNamespace = Just "Tests" }) inputFile $ \e ->

71+ assert preludeExterns (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) inputFile $ \e ->

6972 case e of

7073 Left _ -> return Nothing

7174 Right _ -> return $ Just "Should not have compiled"

@@ -78,7 +81,7 @@ main :: IO ()

7881main = do

7982 prelude <- P.preludeFilename

8083 putStrLn "Compiling Prelude"

81− preludeResult <- compile (P.defaultOptions { P.optionsBrowserNamespace = Just "Tests" }) [prelude]

84+ preludeResult <- compile (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) [prelude]

8285 case preludeResult of

8386 Left err -> putStrLn err >> exitFailure

8487 Right (preludeJs, exts, _) -> do

@@ -97,3 +100,4 @@ main = do

97100 forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $

98101 assertDoesNotCompile preludeExterns (failing ++ pathSeparator : inputFile)

99102 exitSuccess

103+