b39c400 · rowtype-yoga/purescript-native

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

on golang help sign in

Fix #580

b39c400Phil Freeman12 years ago

psc-make/Main.hs+6−5

compare with golang

unifiedsplit

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

12--

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

15−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

17module Main where

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

66 liftError = either throwError return

67 progress = makeIO . U.putStrLn

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

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

70compile prelude input outputDir opts usePrefix = do

71 modules <- readInput allInputFiles

72 case modules of

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

81 exitFailure

82 Right _ -> do

83 exitSuccess

84− where

84+ where

85 prefix = if usePrefix

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

87 else []

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

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

125 { optDoc = "Display verbose error messages" }

126

127−options :: Term P.Options

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

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

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

129

130noPrefix :: Term Bool

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

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

145main = do

146 prelude <- P.preludeFilename

147 run (term prelude, termInfo)

148+

psc/Main.hs+8−5

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

12--

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

15−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

17module Main where

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

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

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

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 ()

48compile prelude opts stdin input output externs usePrefix = do

49 modules <- readInput stdInOrInputFiles

50 case modules of

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

70 | P.optionsNoPrelude opts = Just input

71 | otherwise = Just $ prelude : input

72 prefix = if usePrefix

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

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

74 else []

76mkdirp :: FilePath -> IO ()

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

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

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

138

139−options :: Term P.Options

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

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

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

141+ where

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

141

143

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

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

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

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

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

154 prelude <- P.preludeFilename

156 prelude <- P.preludeFilename

155 run (term prelude, termInfo)

157 run (term prelude, termInfo)

156

158

159+

psci/Main.hs+8−8

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

13--

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

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

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

18module Main where

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

198

199-- | Compilation options.

200--

201−options :: P.Options

201+options :: P.Options P.Make

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

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

203

204-- |

205-- PSCI monad

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

276handleDeclaration value = do

277 st <- PSCI $ lift get

278 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)]) []

280 case e of

281 Left err -> PSCI $ outputStrLn err

282 Right _ -> do

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

295handleTypeOf value = do

296 st <- PSCI $ lift get

297 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)]) []

299 case e of

300 Left err -> PSCI $ outputStrLn err

301 Right env' ->

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

311 st <- PSCI $ lift get

312 let m = createTemporaryModuleForKind st typ

313 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)]) []

315 case e of

316 Left err -> PSCI $ outputStrLn err

317 Right env' ->

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

374singleLineFlag :: Cmd.Term Bool

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

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

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

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

378 }

379

380inputFiles :: Cmd.Term [FilePath]

381inputFiles = 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"

383 }

384

385loadUserConfig :: IO (Maybe [Command])

src/Language/PureScript.hs+14−12

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

13--

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

16+{-# LANGUAGE DataKinds #-}

17+

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

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

18import Language.PureScript.Types as P

20import Language.PureScript.Types as P

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

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

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

40import Data.Time.Clock

42import Data.Time.Clock

41import Data.Function (on)

43import Data.Function (on)

42−import Data.Maybe (fromJust, fromMaybe)

44+import Data.Maybe (fromMaybe)

43import Control.Monad.Error

45import Control.Monad.Error

44import Control.Monad.State.Lazy

46import Control.Monad.State.Lazy

45import Control.Arrow ((&&&))

47import Control.Arrow ((&&&))

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

67--

69--

68-- * Pretty-print the generated Javascript

70-- * Pretty-print the generated Javascript

69--

71--

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

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

71compile = compile' initEnvironment

73compile = compile' initEnvironment

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

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

74compile' env opts ms prefix = do

76compile' env opts ms prefix = do

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

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

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

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

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

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

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

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

79− let entryPoints = moduleNameFromString `map` optionsModules opts

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

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

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

81 let renamed = renameInModules elim

83 let renamed = renameInModules elim

82− let codeGenModules = moduleNameFromString `map` optionsCodeGenModules opts

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

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

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

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

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

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

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

86 js' <- generateMain env' opts js

88 js' <- generateMain env' opts js

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

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

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

126 go _ = True

128 go _ = True

127

129

128

130

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

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

130generateMain env opts js =

132generateMain env opts js =

131 case moduleNameFromString <$> optionsMain opts of

133 case moduleNameFromString <$> optionsMain opts of

132 Just mmi -> do

134 Just mmi -> do

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

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

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

136 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))))) []]

136 _ -> return js

138 _ -> return js

137

139

138-- |

140-- |

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

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

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

171-- having to typecheck the module again.

173-- having to typecheck the module again.

172--

174--

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

174make outputDir opts ms prefix = do

176make outputDir opts ms prefix = do

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

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

176

178

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

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

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

217

219

218 let mod' = Module moduleName' regrouped exps

220 let mod' = Module moduleName' regrouped exps

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

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

220

222

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

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

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

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

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

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

224

226

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

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

13--

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

16−{-# LANGUAGE DoAndIfThenElse #-}

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

18module Language.PureScript.CodeGen.JS (

19 module AST,

20− ModuleType(..),

21 declToJs,

20 declToJs,

22 moduleToJs,

21 moduleToJs,

23 identNeedsEscaping

22 identNeedsEscaping

24) where

23) where

26−import Data.Maybe (catMaybes, fromJust)

25+import Data.Maybe (catMaybes)

27import Data.Function (on)

26import Data.Function (on)

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

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

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

42import Language.PureScript.Traversals (sndM)

41import Language.PureScript.Traversals (sndM)

43import qualified Language.PureScript.Constants as C

42import qualified Language.PureScript.Constants as C

45−-- |

46−-- Different types of modules which are supported

47−--

48−data ModuleType = CommonJS | Globals

49−

50-- |

44-- |

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

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

52-- module.

46-- module.

53--

47--

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

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

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

49+moduleToJs 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

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

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

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

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

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

59 let isModuleEmpty = null exps

53 let isModuleEmpty = null exps

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

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

61 let moduleExports = JSObjectLiteral $ concatMap exportToJs exps

55 let moduleExports = JSObjectLiteral $ concatMap exportToJs exps

62− return $ case mt of

56+ return $ case optionsAdditional opts of

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

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

64− Globals | not isModuleEmpty ->

58+ CompileOptions ns _ _ | not isModuleEmpty ->

65− [ JSVariableIntroduction (fromJust (optionsBrowserNamespace opts))

59+ [ JSVariableIntroduction ns

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

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

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

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

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

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

69 ]

63 ]

70 _ -> []

64 _ -> []

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

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

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

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

68+importToJs opts mn =

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

69+ JSVariableIntroduction (moduleNameToJs mn) (Just moduleBody)

75 where

70 where

76− moduleBody = case mt of

71+ moduleBody = case optionsAdditional opts of

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

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

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

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

80imports :: Declaration -> [ModuleName]

75imports :: Declaration -> [ModuleName]

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

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

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

95-- |

90-- |

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

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

97--

92--

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])

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

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

100 js <- valueToJs opts mp e val

95 js <- valueToJs opts mp e val

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

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

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

190-- |

185-- |

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

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

192--

187--

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

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

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

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

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

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

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

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

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

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

316-- and guards.

311-- and guards.

317--

312--

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

319bindersToJs opts m e binders vals = do

314bindersToJs opts m e binders vals = do

320 valNames <- replicateM (length vals) freshName

315 valNames <- replicateM (length vals) freshName

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

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

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

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

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

406 js2

401 js2

407 )) Nothing]

402 )) Nothing]

408− where

403+ where

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

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

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

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

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

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

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

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

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

417 binderToJs m e varName done binder

412 binderToJs m e varName done binder

418

413

414+

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

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

49-- |

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

51--

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

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

53optimize opts | optionsNoOptimizations opts = id

54 | otherwise = untilFixedPoint (applyAll

55 [ collapseNestedBlocks

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

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

29import qualified Language.PureScript.Constants as C

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

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

32magicDo opts | optionsNoMagicDo opts = id

33 | otherwise = inlineST . magicDo'

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

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

21-- |

22-- Eliminate tail calls

23--

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

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

25tco opts | optionsNoTco opts = id

26 | otherwise = tco'

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

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

13--

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

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

17+

16module Language.PureScript.Options where

18module Language.PureScript.Options where

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+

18-- |

43-- |

19-- The data type of compiler options

44-- The data type of compiler options

20--

45--

21−data Options = Options {

46+data Options mode = Options {

22 -- |

47 -- |

23 -- Disable inclusion of the built in Prelude

48 -- Disable inclusion of the built in Prelude

24 --

49 --

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

44 -- Skip all optimizations

69 -- Skip all optimizations

45 --

70 --

46 , optionsNoOptimizations :: Bool

71 , 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]

60 -- |

72 -- |

61 -- Verbose error message

73 -- Verbose error message

62 --

74 --

63 , optionsVerboseErrors :: Bool

75 , 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

65 } deriving Show

81 } deriving Show

67-- |

83-- |

68-- Default compiler options

84-- Default compiler options

69--

85--

70−defaultOptions :: Options

86+defaultCompileOptions :: Options Compile

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

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) })

190-- |

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

192--

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

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

194runCheck opts = runCheck' opts initEnvironment

195

196-- |

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

198--

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

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

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

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

202 return (a, checkEnv s)

tests/Main.hs+11−7

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

12--

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

15−{-# LANGUAGE DoAndIfThenElse #-}

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

17module Main (main) where

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

34 text <- U.readFile inputFile

35 return $ P.runIndentParser inputFile P.parseModules text

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))

38compile opts inputFiles = do

39 modules <- readInput inputFiles

40 case modules of

41 Left parseError ->

42 return (Left $ show parseError)

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

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

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 ()

46assert preludeExterns opts inputFile f = do

47 e <- compile opts [preludeExterns, inputFile]

48 maybeErr <- f e

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

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

54assertCompiles preludeJs preludeExterns inputFile = do

55 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+ }

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

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

58 process <- findNodeProcess

61 process <- findNodeProcess

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

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

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

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

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

66assertDoesNotCompile preludeExterns inputFile = do

69assertDoesNotCompile preludeExterns inputFile = do

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

70 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 ->

69 case e of

72 case e of

70 Left _ -> return Nothing

73 Left _ -> return Nothing

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

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

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

78main = do

81main = do

79 prelude <- P.preludeFilename

82 prelude <- P.preludeFilename

80 putStrLn "Compiling Prelude"

83 putStrLn "Compiling Prelude"

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

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

82 case preludeResult of

85 case preludeResult of

83 Left err -> putStrLn err >> exitFailure

86 Left err -> putStrLn err >> exitFailure

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

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

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

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

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

98 assertDoesNotCompile preludeExterns (failing ++ pathSeparator : inputFile)

101 assertDoesNotCompile preludeExterns (failing ++ pathSeparator : inputFile)

99 exitSuccess

102 exitSuccess

103+