81bb633 · rowtype-yoga/purescript-native

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

on golang help sign in

Merge branch 'commonjs1'

81bb633Phil Freeman13 years ago

prelude/prelude.purs+1−1

compare with golang

unifiedsplit

@@ -271,7 +271,7 @@ module Prelude where

271 foreign import numCompare

272 "function numCompare(n1) {\

273 \ return function(n2) {\

274− \ return n1 < n2 ? module.LT : n1 > n2 ? module.GT : module.EQ;\

274+ \ return n1 < n2 ? LT : n1 > n2 ? GT : EQ;\

275 \ };\

276 \}" :: Number -> Number -> Ordering

277

psc-make/Main.hs+10−9

@@ -67,16 +67,17 @@ instance P.MonadMake Make where

67 U.putStrLn $ "Writing " ++ path

68 U.writeFile path text

69 liftError = either throwError return

70+ progress = makeIO . U.putStrLn

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

72+compile :: FilePath -> P.Options -> [FilePath] -> IO ()

72−compile opts input = do

73+compile outputDir opts input = do

73 modules <- readInput input

74 modules <- readInput input

74 case modules of

75 case modules of

75 Left err -> do

76 Left err -> do

76 U.print err

77 U.print err

77 exitFailure

78 exitFailure

78 Right ms -> do

79 Right ms -> do

79− e <- runMake $ P.make opts ms

80+ e <- runMake $ P.make outputDir opts ms

80 case e of

81 case e of

81 Left err -> do

82 Left err -> do

82 U.putStrLn err

83 U.putStrLn err

@@ -91,6 +92,10 @@ inputFiles :: Term [FilePath]

91inputFiles = value $ posAny [] $ posInfo

92inputFiles = value $ posAny [] $ posInfo

92 { posDoc = "The input .ps files" }

93 { posDoc = "The input .ps files" }

95+outputDirectory :: Term FilePath

96+outputDirectory = value $ opt "output" $ (optInfo [ "o", "output" ])

97+ { optDoc = "The output directory" }

98+

94noTco :: Term Bool

99noTco :: Term Bool

95noTco = value $ flag $ (optInfo [ "no-tco" ])

100noTco = value $ flag $ (optInfo [ "no-tco" ])

96 { optDoc = "Disable tail call optimizations" }

101 { optDoc = "Disable tail call optimizations" }

@@ -111,16 +116,12 @@ noOpts :: Term Bool

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

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

112 { optDoc = "Skip the optimization phase." }

117 { optDoc = "Skip the optimization phase." }

113

118

114−browserNamespace :: Term String

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

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

117−

118verboseErrors :: Term Bool

119verboseErrors :: Term Bool

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

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

120 { optDoc = "Display verbose error messages" }

121 { optDoc = "Display verbose error messages" }

121

122

122options :: Term P.Options

123options :: Term P.Options

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

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

124

125

125inputFilesAndPrelude :: FilePath -> Term [FilePath]

126inputFilesAndPrelude :: FilePath -> Term [FilePath]

126inputFilesAndPrelude prelude = combine <$> (not <$> noPrelude) <*> inputFiles

127inputFilesAndPrelude prelude = combine <$> (not <$> noPrelude) <*> inputFiles

@@ -129,7 +130,7 @@ inputFilesAndPrelude prelude = combine <$> (not <$> noPrelude) <*> inputFiles

129 combine False input = input

130 combine False input = input

130

131

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

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

132−term prelude = compile <$> options <*> inputFilesAndPrelude prelude

133+term prelude = compile <$> outputDirectory <*> options <*> inputFilesAndPrelude prelude

133

134

134termInfo :: TermInfo

135termInfo :: TermInfo

135termInfo = defTI

136termInfo = defTI

psc/Main.hs+2−1

@@ -127,7 +127,7 @@ verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])

127 { optDoc = "Display verbose error messages" }

128

129options :: Term P.Options

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

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

131

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

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

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

150main = do

151 prelude <- preludeFilename

152 run (term prelude, termInfo)

153+

psci/Main.hs+101−47

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

13--

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

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

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

18module Main where

@@ -24,29 +24,36 @@ import Control.Monad

24import Control.Monad.Trans.Class

25import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

26import Control.Monad.Trans.State.Strict

27+import Control.Monad.Error (ErrorT(..), MonadError)

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

28import Data.List (intercalate, isPrefixOf, nub, sortBy)

30import Data.List (intercalate, isPrefixOf, nub, sortBy)

29import Data.Maybe (mapMaybe)

31import Data.Maybe (mapMaybe)

30import Data.Foldable (traverse_)

32import Data.Foldable (traverse_)

31−import Data.Traversable (traverse)

32import Data.Version (showVersion)

33import Data.Version (showVersion)

34+import Data.Traversable (traverse)

34import Parser

36import Parser

38+import System.IO.Error (tryIOError)

36import System.Console.Haskeline

39import System.Console.Haskeline

40+import System.Directory

41+ (createDirectoryIfMissing, getModificationTime, doesFileExist,

37−import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)

42+ findExecutable, getHomeDirectory, getCurrentDirectory)

43+import System.Process (readProcessWithExitCode)

38import System.Exit

44import System.Exit

39import System.Environment.XDG.BaseDir

45import System.Environment.XDG.BaseDir

40−import System.FilePath ((</>), isPathSeparator)

46+import System.FilePath

47+ (pathSeparator, takeDirectory, (</>), isPathSeparator)

41import qualified System.Console.CmdTheLine as Cmd

48import qualified System.Console.CmdTheLine as Cmd

42−import System.Process

44import Text.Parsec (ParseError)

50import Text.Parsec (ParseError)

46import qualified Data.Map as M

52import qualified Data.Map as M

47import qualified Language.PureScript as P

53import qualified Language.PureScript as P

48import qualified Paths_purescript as Paths

54import qualified Paths_purescript as Paths

49−import qualified System.IO.UTF8 as U (print, readFile)

55+import qualified System.IO.UTF8 as U

56+ (writeFile, putStrLn, print, readFile)

51-- |

58-- |

52-- The PSCI state.

59-- The PSCI state.

@@ -57,7 +64,7 @@ import qualified System.IO.UTF8 as U (print, readFile)

57data PSCiState = PSCiState

64data PSCiState = PSCiState

58 { psciImportedFilenames :: [FilePath]

65 { psciImportedFilenames :: [FilePath]

59 , psciImportedModuleNames :: [P.ModuleName]

66 , psciImportedModuleNames :: [P.ModuleName]

60− , psciLoadedModules :: [P.Module]

67+ , psciLoadedModules :: [(FilePath, P.Module)]

61 , psciLetBindings :: [P.Value -> P.Value]

68 , psciLetBindings :: [P.Value -> P.Value]

62 }

69 }

@@ -78,7 +85,7 @@ updateImports name st = st { psciImportedModuleNames = name : psciImportedModule

78-- |

85-- |

79-- Updates the state to have more loaded files.

86-- Updates the state to have more loaded files.

80--

87--

81−updateModules :: [P.Module] -> PSCiState -> PSCiState

88+updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState

82updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }

89updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }

84-- |

91-- |

@@ -168,7 +175,7 @@ completion = completeWord Nothing " \t\n\r" findCompletions

168 where

175 where

169 findCompletions :: String -> StateT PSCiState IO [Completion]

176 findCompletions :: String -> StateT PSCiState IO [Completion]

170 findCompletions str = do

177 findCompletions str = do

171− ms <- psciLoadedModules <$> get

178+ ms <- map snd . psciLoadedModules <$> get

172 files <- listFiles str

179 files <- listFiles str

173 let matches = filter (isPrefixOf str) (names ms)

180 let matches = filter (isPrefixOf str) (names ms)

174 return $ sortBy sorter $ map simpleCompletion matches ++ files

181 return $ sortBy sorter $ map simpleCompletion matches ++ files

@@ -197,7 +204,39 @@ completion = completeWord Nothing " \t\n\r" findCompletions

197-- | Compilation options.

204-- | Compilation options.

198--

205--

199options :: P.Options

206options :: P.Options

200−options = P.Options False True False True (Just "Main") True "PS" [] [] False

207+options = P.Options False True False True Nothing True Nothing [] [] False

208+

209+-- |

210+-- PSCI monad

211+--

212+newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)

213+

214+psciIO :: IO a -> PSCI a

215+psciIO io = PSCI (lift (lift io))

216+

217+newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadError String)

218+

219+runMake :: Make a -> IO (Either String a)

220+runMake = runErrorT . unMake

221+

222+makeIO :: IO a -> Make a

223+makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError

224+

225+instance P.MonadMake Make where

226+ getTimestamp path = makeIO $ do

227+ exists <- doesFileExist path

228+ case exists of

229+ True -> Just <$> getModificationTime path

230+ False -> return Nothing

231+ readTextFile path = makeIO $ U.readFile path

232+ writeTextFile path text = makeIO $ do

233+ mkdirp path

234+ U.writeFile path text

235+ liftError = either throwError return

236+ progress s = unless (s == "Compiling Main") $ makeIO . U.putStrLn $ s

237+

238+mkdirp :: FilePath -> IO ()

239+mkdirp = createDirectoryIfMissing True . takeDirectory

201

240

202-- |

241-- |

203-- Makes a volatile module to execute the current expression.

242-- Makes a volatile module to execute the current expression.

@@ -217,34 +256,45 @@ createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetB

217 in

256 in

218 P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing

257 P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing

219

258

259+modulesDir :: FilePath

260+modulesDir = "psci_modules" ++ pathSeparator : "node_modules"

261+

262+indexFile :: FilePath

263+indexFile = "psci_modules" ++ pathSeparator : "index.js"

264+

220-- |

265-- |

221-- Takes a value declaration and evaluates it with the current state.

266-- Takes a value declaration and evaluates it with the current state.

222--

267--

223−handleDeclaration :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()

268+handleDeclaration :: P.Value -> PSCI ()

224−handleDeclaration value st = do

269+handleDeclaration value = do

270+ st <- PSCI $ lift get

225 let m = createTemporaryModule True st value

271 let m = createTemporaryModule True st value

226− case P.compile options (psciLoadedModules st ++ [m]) of

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

273+ case e of

227− Left err -> outputStrLn err

274+ Left err -> PSCI $ outputStrLn err

228− Right (js, _, _) -> do

275+ Right _ -> do

276+ psciIO $ writeFile indexFile $ "require('Main').main();"

229− process <- lift . lift $ findNodeProcess

277+ process <- psciIO findNodeProcess

230− result <- lift . lift $ traverse (\node -> readProcessWithExitCode node [] js) process

278+ result <- psciIO $ traverse (\node -> readProcessWithExitCode node [indexFile] "") process

231 case result of

279 case result of

232− Just (ExitSuccess, out, _) -> outputStrLn out

280+ Just (ExitSuccess, out, _) -> PSCI $ outputStrLn out

233− Just (ExitFailure _, _, err) -> outputStrLn err

281+ Just (ExitFailure _, _, err) -> PSCI $ outputStrLn err

234− Nothing -> outputStrLn "Couldn't find node.js"

282+ Nothing -> PSCI $ outputStrLn "Couldn't find node.js"

235

283

236-- |

284-- |

237-- Takes a value and prints its type

285-- Takes a value and prints its type

238--

286--

239−handleTypeOf :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()

287+handleTypeOf :: P.Value -> PSCI ()

240−handleTypeOf value st = do

288+handleTypeOf value = do

289+ st <- PSCI $ lift get

241 let m = createTemporaryModule False st value

290 let m = createTemporaryModule False st value

242− case P.compile options { P.optionsMain = Nothing } (psciLoadedModules st ++ [m]) of

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

292+ case e of

243− Left err -> outputStrLn err

293+ Left err -> PSCI $ outputStrLn err

244− Right (_, _, env') ->

294+ Right env' ->

245 case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of

295 case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of

246− Just (ty, _) -> outputStrLn . P.prettyPrintType $ ty

296+ Just (ty, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty

247− Nothing -> outputStrLn "Could not find type"

297+ Nothing -> PSCI $ outputStrLn "Could not find type"

248

298

249-- Commands

299-- Commands

250

300

@@ -265,27 +315,31 @@ getCommand = do

265-- |

315-- |

266-- Performs an action for each meta-command given, and also for expressions..

316-- Performs an action for each meta-command given, and also for expressions..

267--

317--

268−handleCommand :: Command -> InputT (StateT PSCiState IO) ()

318+handleCommand :: Command -> PSCI ()

269−handleCommand (Expression val) = lift get >>= handleDeclaration val

319+handleCommand (Expression val) = handleDeclaration val

270−handleCommand Help = outputStrLn helpMessage

320+handleCommand Help = PSCI $ outputStrLn helpMessage

271−handleCommand (Import moduleName) = lift $ modify (updateImports moduleName)

321+handleCommand (Import moduleName) = PSCI $ lift $ modify (updateImports moduleName)

272−handleCommand (Let l) = lift $ modify (updateLets l)

322+handleCommand (Let l) = PSCI $ lift $ modify (updateLets l)

273handleCommand (LoadFile filePath) = do

323handleCommand (LoadFile filePath) = do

274− absPath <- lift . lift $ expandTilde filePath

324+ absPath <- psciIO $ expandTilde filePath

275− exists <- lift . lift $ doesFileExist absPath

325+ exists <- psciIO $ doesFileExist absPath

276 if exists then do

326 if exists then do

277− lift $ modify (updateImportedFiles absPath)

327+ PSCI . lift $ modify (updateImportedFiles absPath)

278− either outputStrLn (lift . modify . updateModules) =<< (lift . lift $ loadModule absPath)

328+ m <- psciIO $ loadModule absPath

329+ case m of

330+ Left err -> PSCI $ outputStrLn err

331+ Right mods -> PSCI . lift $ modify (updateModules (map ((,) absPath) mods))

279 else

332 else

280− outputStrLn $ "Couldn't locate: " ++ filePath

333+ PSCI . outputStrLn $ "Couldn't locate: " ++ filePath

281handleCommand Reset = do

334handleCommand Reset = do

282− files <- psciImportedFilenames <$> lift get

335+ files <- psciImportedFilenames <$> PSCI (lift get)

336+ filesAndModules <- mapM (\file -> fmap (fmap (map ((,) file))) . psciIO . loadModule $ file) files

283− modulesOrFirstError <- fmap concat . sequence <$> mapM (lift . lift . loadModule) files

337+ let modulesOrFirstError = fmap concat $ sequence filesAndModules

284 case modulesOrFirstError of

338 case modulesOrFirstError of

285− Left err -> lift . lift $ putStrLn err >> exitFailure

339+ Left err -> psciIO $ putStrLn err >> exitFailure

286− Right modules -> lift $ put (PSCiState files defaultImports modules [])

340+ Right modules -> PSCI . lift $ put (PSCiState files defaultImports modules [])

287−handleCommand (TypeOf val) = lift get >>= handleTypeOf val

341+handleCommand (TypeOf val) = handleTypeOf val

288−handleCommand _ = outputStrLn "Unknown command"

342+handleCommand _ = PSCI $ outputStrLn "Unknown command"

289

343

290inputFiles :: Cmd.Term [FilePath]

344inputFiles :: Cmd.Term [FilePath]

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

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

@@ -311,7 +365,8 @@ loop :: [FilePath] -> IO ()

311loop files = do

365loop files = do

312 config <- loadUserConfig

366 config <- loadUserConfig

313 preludeFilename <- getPreludeFilename

367 preludeFilename <- getPreludeFilename

314− modulesOrFirstError <- fmap concat . sequence <$> mapM loadModule (preludeFilename : files)

368+ filesAndModules <- mapM (\file -> fmap (fmap (map ((,) file))) . loadModule $ file) (preludeFilename : files)

369+ let modulesOrFirstError = fmap concat $ sequence filesAndModules

315 case modulesOrFirstError of

370 case modulesOrFirstError of

316 Left err -> putStrLn err >> exitFailure

371 Left err -> putStrLn err >> exitFailure

317 Right modules -> do

372 Right modules -> do

@@ -319,7 +374,7 @@ loop files = do

319 let settings = defaultSettings {historyFile = Just historyFilename}

374 let settings = defaultSettings {historyFile = Just historyFilename}

320 flip evalStateT (PSCiState (preludeFilename : files) defaultImports modules []) . runInputT (setComplete completion settings) $ do

375 flip evalStateT (PSCiState (preludeFilename : files) defaultImports modules []) . runInputT (setComplete completion settings) $ do

321 outputStrLn prologueMessage

376 outputStrLn prologueMessage

322− traverse_ (mapM_ handleCommand) config

377+ traverse_ (mapM_ (runPSCI . handleCommand)) config

323 go

378 go

324 where

379 where

325 go :: InputT (StateT PSCiState IO) ()

380 go :: InputT (StateT PSCiState IO) ()

@@ -329,7 +384,7 @@ loop files = do

329 Left err -> outputStrLn (show err) >> go

384 Left err -> outputStrLn (show err) >> go

330 Right Nothing -> go

385 Right Nothing -> go

331 Right (Just Quit) -> outputStrLn quitMessage

386 Right (Just Quit) -> outputStrLn quitMessage

332− Right (Just c') -> handleCommand c' >> go

387+ Right (Just c') -> runPSCI (handleCommand c') >> go

333

388

334term :: Cmd.Term (IO ())

389term :: Cmd.Term (IO ())

335term = loop <$> inputFiles

390term = loop <$> inputFiles

@@ -343,4 +398,3 @@ termInfo = Cmd.defTI

343

398

344main :: IO ()

399main :: IO ()

345main = Cmd.run (term, termInfo)

400main = Cmd.run (term, termInfo)

346−

src/Language/PureScript.hs+35−33

@@ -37,7 +37,7 @@ import Data.List (find, sortBy, groupBy, intercalate)

37import Data.Time.Clock

38import Data.Function (on)

39import Data.Generics (mkQ, everything)

40−import Data.Maybe (fromMaybe, mapMaybe)

40+import Data.Maybe (fromJust, fromMaybe)

41import Control.Monad.Error

42import Control.Monad.State.Lazy

43import Control.Arrow ((&&&))

@@ -78,10 +78,10 @@ compile' env opts ms = do

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

79 let codeGenModules = moduleNameFromString `map` optionsCodeGenModules opts

80 let modulesToCodeGen = if null codeGenModules then elim else filter (\(Module mn _ _) -> mn `elem` codeGenModules) elim

81− let js = mapMaybe (flip (moduleToJs opts) env') modulesToCodeGen

81+ let js = concatMap (\m -> moduleToJs Globals opts m env') modulesToCodeGen

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

83 js' <- generateMain env' opts js

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

84+ return (prettyPrintJS js', exts, env')

85 where

86 mainModuleIdent = moduleNameFromString <$> optionsMain opts

@@ -128,7 +128,7 @@ generateMain env opts js =

128 Just mmi -> do

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

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

131− return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar C._ps))) []]

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

132 _ -> return js

133

134-- |

@@ -155,6 +155,10 @@ class MonadMake m where

155 --

156 liftError :: Either String a -> m a

157

158+ -- |

159+ -- Respond to a progress update

160+ --

161+ progress :: String -> m ()

158

162

159-- |

163-- |

160-- Compiles in "make" mode, compiling each module separately to a js files and an externs file

164-- Compiles in "make" mode, compiling each module separately to a js files and an externs file

@@ -162,17 +166,17 @@ class MonadMake m where

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

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

163-- having to typecheck the module again.

167-- having to typecheck the module again.

164--

168--

165−make :: (Functor m, Monad m, MonadMake m) => Options -> [(FilePath, Module)] -> m ()

169+make :: (Functor m, Monad m, MonadMake m) => FilePath -> Options -> [(FilePath, Module)] -> m Environment

166−make opts ms = do

170+make outputDir opts ms = do

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

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

168

172

169 (sorted, graph) <- liftError $ sortModules $ if optionsNoPrelude opts then map snd ms else (map (importPrelude . snd) ms)

173 (sorted, graph) <- liftError $ sortModules $ if optionsNoPrelude opts then map snd ms else (map (importPrelude . snd) ms)

170

174

171 toRebuild <- foldM (\s (Module moduleName' _ _) -> do

175 toRebuild <- foldM (\s (Module moduleName' _ _) -> do

172− let filePath = toFileName moduleName'

176+ let filePath = runModuleName moduleName'

173

177

174− jsFile = "js" ++ pathSeparator : filePath ++ ".js"

178+ jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"

175− externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"

179+ externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"

176 inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap

180 inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap

177

181

178 jsTimestamp <- getTimestamp jsFile

182 jsTimestamp <- getTimestamp jsFile

@@ -190,47 +194,45 @@ make opts ms = do

190 go initEnvironment desugared

194 go initEnvironment desugared

191

195

192 where

196 where

193− go :: (Functor m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> m ()

197+ go :: (Functor m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> m Environment

194− go _ [] = return ()

198+ go env [] = return env

195 go env ((False, m) : ms') = do

199 go env ((False, m) : ms') = do

196 (_, env') <- liftError . runCheck' opts env $ typeCheckModule Nothing m

200 (_, env') <- liftError . runCheck' opts env $ typeCheckModule Nothing m

197

201

198 go env' ms'

202 go env' ms'

199 go env ((True, m@(Module moduleName' _ exps)) : ms') = do

203 go env ((True, m@(Module moduleName' _ exps)) : ms') = do

200− let filePath = toFileName moduleName'

204+ let filePath = runModuleName moduleName'

201− jsFile = "js" ++ pathSeparator : filePath ++ ".js"

205+ jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"

202− externsFile = "externs" ++ pathSeparator : filePath ++ ".externs"

206+ externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"

207+

208+ progress $ "Compiling " ++ runModuleName moduleName'

203

209

204 (Module _ elaborated _, env') <- liftError . runCheck' opts env $ typeCheckModule Nothing m

210 (Module _ elaborated _, env') <- liftError . runCheck' opts env $ typeCheckModule Nothing m

205

211

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

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

207

213

208 let mod' = Module moduleName' regrouped exps

214 let mod' = Module moduleName' regrouped exps

209− js = moduleToJs opts mod' env'

215+ js = prettyPrintJS $ moduleToJs CommonJS opts mod' env'

210 exts = moduleToPs mod' env'

216 exts = moduleToPs mod' env'

211− js' = maybe "" (prettyPrintJS . return . wrapExportsContainer opts . return) js

212

217

213− writeTextFile jsFile js'

218+ writeTextFile jsFile js

214 writeTextFile externsFile exts

219 writeTextFile externsFile exts

215

220

216 go env' ms'

221 go env' ms'

217

222

218−toFileName :: ModuleName -> FilePath

219−toFileName (ModuleName ps) = intercalate [pathSeparator] . map runProperName $ ps

220−

221−rebuildIfNecessary :: (Functor m, Monad m, MonadMake m) => M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

223+ rebuildIfNecessary :: (Functor m, Monad m, MonadMake m) => M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

222−rebuildIfNecessary _ _ [] = return []

224+ rebuildIfNecessary _ _ [] = return []

223−rebuildIfNecessary graph toRebuild (m@(Module moduleName' _ _) : ms) | moduleName' `S.member` toRebuild = do

225+ rebuildIfNecessary graph toRebuild (m@(Module moduleName' _ _) : ms') | moduleName' `S.member` toRebuild = do

224− let deps = fromMaybe [] $ moduleName' `M.lookup` graph

226+ let deps = fromMaybe [] $ moduleName' `M.lookup` graph

225− toRebuild' = toRebuild `S.union` S.fromList deps

227+ toRebuild' = toRebuild `S.union` S.fromList deps

226− (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms

228+ (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'

227−rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms) = do

229+ rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do

228− let externsFile = "externs" ++ pathSeparator : toFileName moduleName' ++ ".externs"

230+ let externsFile = outputDir ++ pathSeparator : runModuleName moduleName' ++ pathSeparator : "externs.purs"

229− externs <- readTextFile externsFile

231+ externs <- readTextFile externsFile

230− externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs

232+ externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs

231− case externsModules of

233+ case externsModules of

232− [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms

234+ [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'

233− _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"

235+ _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"

234

236

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

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

236reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]

238reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]

src/Language/PureScript/CodeGen/JS.hs+43−39

@@ -17,14 +17,16 @@

18module Language.PureScript.CodeGen.JS (

19 module AST,

20+ ModuleType(..),

20 declToJs,

21 declToJs,

21 moduleToJs,

22 moduleToJs,

22− wrapExportsContainer,

23 isIdent

24) where

26−import Data.Maybe (fromMaybe, mapMaybe)

26+import Data.Maybe (fromJust, fromMaybe, mapMaybe)

27import Data.Function (on)

28+import Data.List (nub, (\\))

29+import Data.Generics (mkQ, everything)

29import Control.Arrow (second)

31import Control.Arrow (second)

30import Control.Monad (replicateM, forM)

32import Control.Monad (replicateM, forM)

@@ -41,26 +43,46 @@ import Language.PureScript.Types

41import Language.PureScript.Optimizer

43import Language.PureScript.Optimizer

42import Language.PureScript.CodeGen.Common

44import Language.PureScript.CodeGen.Common

43import Language.PureScript.Environment

45import Language.PureScript.Environment

44−import qualified Language.PureScript.Constants as C

46+

47+-- |

48+-- Different types of modules which are supported

49+--

50+data ModuleType = CommonJS | Globals

46-- |

52-- |

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

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

48-- module.

54-- module.

49--

55--

50−moduleToJs :: Options -> Module -> Environment -> Maybe JS

56+moduleToJs :: ModuleType -> Options -> Module -> Environment -> [JS]

51−moduleToJs opts (Module name decls (Just exps)) env =

57+moduleToJs mt opts (Module name decls (Just exps)) env = case mt of

52− case jsDecls of

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

53− [] -> Nothing

59+ Globals ->

60+ [ JSVariableIntroduction (fromJust (optionsBrowserNamespace opts))

61+ (Just (JSBinary Or (JSVar (fromJust (optionsBrowserNamespace opts))) (JSObjectLiteral [])) )

54− _ -> Just $ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar C._ps)) $

62+ , JSAssignment (JSAccessor (moduleNameToJs name) (JSVar (fromJust (optionsBrowserNamespace opts))))

55− JSApp (JSFunction Nothing [] (JSBlock $

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

56− JSVariableIntroduction "module" (Just $ JSObjectLiteral []) :

64+ ]

57− jsDecls ++

58− jsExports ++

59− [JSReturn $ JSVar "module"])) []

60 where

65 where

66+ moduleBody = JSStringLiteral "use strict" : jsImports ++ jsDecls

67+ moduleExports = JSObjectLiteral $ concatMap exportToJs exps

61 jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts name decl env) decls)

68 jsDecls = (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts name decl env) decls)

62− jsExports = concatMap exportToJs exps

69+ jsImports = map (importToJs mt opts) . (\\ [name]) . nub $ concatMap imports decls

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

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

71+

72+importToJs :: ModuleType -> Options -> ModuleName -> JS

73+importToJs mt opts mn = JSVariableIntroduction (moduleNameToJs mn) (Just moduleBody)

74+ where

75+ moduleBody = case mt of

76+ CommonJS -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn)]

77+ Globals -> JSAccessor (moduleNameToJs mn) (JSVar (fromJust (optionsBrowserNamespace opts)))

78+

79+imports :: Declaration -> [ModuleName]

80+imports = everything (++) (mkQ [] collect)

81+ where

82+ collect :: Value -> [ModuleName]

83+ collect (Var (Qualified (Just mn) _)) = [mn]

84+ collect (Constructor (Qualified (Just mn) _)) = [mn]

85+ collect _ = []

65-- |

87-- |

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

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

@@ -87,22 +109,14 @@ declToJs opts mp (PositionedDeclaration _ d) e = declToJs opts mp d e

87declToJs _ _ _ _ = Nothing

109declToJs _ _ _ _ = Nothing

110

89-- |

111-- |

90−-- Generate code in the simplified Javascript intermediate representation for an export from a

112+-- Generate key//value pairs for an object literal exporting values from a module.

91−-- module.

92--

113--

93−exportToJs :: DeclarationRef -> [JS]

114+exportToJs :: DeclarationRef -> [(String, JS)]

94−exportToJs (TypeRef _ (Just dctors)) = flip map dctors (export . Ident . runProperName)

115+exportToJs (TypeRef _ (Just dctors)) = map ((\n -> (n, var (Ident n))) . runProperName) dctors

95−exportToJs (ValueRef name) = [export name]

116+exportToJs (ValueRef name) = [(runIdent name, var name)]

96−exportToJs (TypeInstanceRef name) = [export name]

117+exportToJs (TypeInstanceRef name) = [(runIdent name, var name)]

97exportToJs _ = []

118exportToJs _ = []

119

99−-- |

100−-- Generate code in the simplified Javascript intermediate representation for assigning an exported

101−-- value to the current module object.

102−--

103−export :: Ident -> JS

104−export ident = JSAssignment (accessor ident (JSVar "module")) (var ident)

105−

106-- |

120-- |

107-- Generate code in the simplified Javascript intermediate representation for a variable based on a

121-- Generate code in the simplified Javascript intermediate representation for a variable based on a

108-- PureScript identifier.

122-- PureScript identifier.

@@ -225,7 +239,7 @@ varToJs m qual = qualifiedToJS m id qual

225-- variable that may have a qualified name.

239-- variable that may have a qualified name.

226--

240--

227qualifiedToJS :: ModuleName -> (a -> Ident) -> Qualified a -> JS

241qualifiedToJS :: ModuleName -> (a -> Ident) -> Qualified a -> JS

228−qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSAccessor (moduleNameToJs m') $ JSVar C._ps)

242+qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSVar (moduleNameToJs m'))

229qualifiedToJS _ f (Qualified _ a) = JSVar $ identToJs (f a)

243qualifiedToJS _ f (Qualified _ a) = JSVar $ identToJs (f a)

230

244

231-- |

245-- |

@@ -328,13 +342,3 @@ isOnlyConstructor e ctor =

328 numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e

342 numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e

329 typeConstructor (Qualified (Just moduleName) _, (tyCtor, _)) = (moduleName, tyCtor)

343 typeConstructor (Qualified (Just moduleName) _, (tyCtor, _)) = (moduleName, tyCtor)

330 typeConstructor _ = error "Invalid argument to isOnlyConstructor"

344 typeConstructor _ = error "Invalid argument to isOnlyConstructor"

331−

332−wrapExportsContainer :: Options -> [JS] -> JS

333−wrapExportsContainer opts modules = JSApp (JSFunction Nothing [C._ps] $ JSBlock $ JSStringLiteral "use strict" : modules) [exportSelector]

334− where

335− exportSelector = JSConditional (JSBinary And (JSBinary NotEqualTo (JSTypeOf $ JSVar "module") (JSStringLiteral "undefined")) (JSAccessor "exports" (JSVar "module")))

336− (JSAccessor "exports" (JSVar "module"))

337− (JSConditional (JSBinary NotEqualTo (JSTypeOf $ JSVar "window") (JSStringLiteral "undefined"))

338− (JSAssignment (JSAccessor browserNamespace (JSVar "window")) (JSBinary Or (JSAccessor browserNamespace (JSVar "window")) (JSObjectLiteral [])))

339− (JSApp (JSFunction Nothing [] $ JSBlock [JSThrow $ JSStringLiteral "PureScript doesn't know how to export modules in the current environment"]) []))

340− browserNamespace = optionsBrowserNamespace opts

src/Language/PureScript/Constants.hs−3

@@ -180,9 +180,6 @@ main = "main"

180

181-- Code Generation

182

183−_ps :: String

184−_ps = "_ps"

185−

186__superclasses :: String

183__superclasses :: String

187__superclasses = "__superclasses"

184__superclasses = "__superclasses"

188

185

src/Language/PureScript/Names.hs+4

@@ -33,6 +33,10 @@ data Ident

33 --

34 | Op String deriving (Eq, Ord, Data, Typeable)

36+runIdent :: Ident -> String

37+runIdent (Ident i) = i

38+runIdent (Op op) = op

39+

36instance Show Ident where

40instance Show Ident where

37 show (Ident s) = s

41 show (Ident s) = s

38 show (Op op) = '(':op ++ ")"

42 show (Op op) = '(':op ++ ")"

src/Language/PureScript/Optimizer/Inliner.hs+7−20

@@ -81,12 +81,8 @@ inlineOperator (m, op) f = everywhere (mkT convert)

81 convert :: JS -> JS

82 convert (JSApp (JSApp op' [x]) [y]) | isOp op' = f x y

83 convert other = other

84− isOp (JSAccessor longForm (JSAccessor m' (JSVar _ps))) | m == m' &&

85− _ps == C._ps &&

86− longForm == identToJs (Op op) = True

84+ isOp (JSAccessor longForm (JSVar m')) = m == m' && longForm == identToJs (Op op)

87− isOp (JSIndexer (JSStringLiteral op') (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&

85+ isOp (JSIndexer (JSStringLiteral op') (JSVar m')) = m == m' && op == op'

88− _ps == C._ps &&

89− op == op' = True

90 isOp _ = False

86 isOp _ = False

92inlineCommonOperators :: JS -> JS

88inlineCommonOperators :: JS -> JS

@@ -131,11 +127,8 @@ inlineCommonOperators = applyAll

131 convert :: JS -> JS

127 convert :: JS -> JS

132 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y

128 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y

133 convert other = other

129 convert other = other

134− isOp (JSAccessor longForm (JSAccessor prelude (JSVar _))) | prelude == C.prelude &&

130+ isOp (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op opString)

135− longForm == identToJs (Op opString) = True

136− isOp (JSIndexer (JSStringLiteral op') (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&

131+ isOp (JSIndexer (JSStringLiteral op') (JSVar prelude)) = prelude == C.prelude && opString == op'

137− _ps == C._ps &&

138− opString == op' = True

139 isOp _ = False

132 isOp _ = False

140 binaryFunction :: String -> String -> BinaryOperator -> JS -> JS

133 binaryFunction :: String -> String -> BinaryOperator -> JS -> JS

141 binaryFunction dictName fnName op = everywhere (mkT convert)

134 binaryFunction dictName fnName op = everywhere (mkT convert)

@@ -143,9 +136,7 @@ inlineCommonOperators = applyAll

143 convert :: JS -> JS

136 convert :: JS -> JS

144 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y

137 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y

145 convert other = other

138 convert other = other

146− isOp (JSAccessor fnName' (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&

139+ isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName == fnName'

147− _ps == C._ps &&

148− fnName == fnName' = True

149 isOp _ = False

140 isOp _ = False

150 unary :: String -> String -> UnaryOperator -> JS -> JS

141 unary :: String -> String -> UnaryOperator -> JS -> JS

151 unary dictName fnName op = everywhere (mkT convert)

142 unary dictName fnName op = everywhere (mkT convert)

@@ -153,11 +144,7 @@ inlineCommonOperators = applyAll

153 convert :: JS -> JS

144 convert :: JS -> JS

154 convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict dictName dict = JSUnary op x

145 convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict dictName dict = JSUnary op x

155 convert other = other

146 convert other = other

156− isOp (JSAccessor fnName' (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&

147+ isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName

157− _ps == C._ps &&

158− fnName' == fnName = True

159 isOp _ = False

148 isOp _ = False

160− isOpDict dictName (JSApp (JSAccessor prop (JSAccessor prelude (JSVar _ps))) [JSObjectLiteral []]) | prelude == C.prelude &&

149+ isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) [JSObjectLiteral []]) = prelude == C.prelude && prop == dictName

161− _ps == C._ps &&

162− prop == dictName = True

163 isOpDict _ _ = False

150 isOpDict _ _ = False

src/Language/PureScript/Optimizer/MagicDo.hs+7−21

@@ -80,31 +80,19 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

80 isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict C.monadEffDictionary effDict = True

81 isReturn _ = False

82 -- Check if an expression represents the polymorphic >>= function

83− isBindPoly (JSAccessor prop (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&

83+ isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == identToJs (Op (C.>>=))

84− _ps == C._ps &&

85− prop == identToJs (Op (C.>>=)) = True

86− isBindPoly (JSIndexer (JSStringLiteral bind) (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&

84+ isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && bind == (C.>>=)

87− _ps == C._ps &&

88− bind == (C.>>=) = True

89 isBindPoly _ = False

85 isBindPoly _ = False

90 -- Check if an expression represents the polymorphic return function

86 -- Check if an expression represents the polymorphic return function

91− isRetPoly (JSAccessor returnEscaped (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&

87+ isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped

92− _ps == C._ps &&

93− returnEscaped == C.returnEscaped = True

94− isRetPoly (JSIndexer (JSStringLiteral return') (JSAccessor prelude (JSVar _ps))) | prelude == C.prelude &&

88+ isRetPoly (JSIndexer (JSStringLiteral return') (JSVar prelude)) = prelude == C.prelude && return' == C.return

95− _ps == C._ps &&

96− return' == C.return = True

97 isRetPoly _ = False

89 isRetPoly _ = False

98 -- Check if an expression represents a function in the Ef module

90 -- Check if an expression represents a function in the Ef module

99− isEffFunc name (JSAccessor name' (JSAccessor eff (JSVar _ps))) | eff == C.eff &&

91+ isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'

100− _ps == C._ps &&

101− name == name' = True

102 isEffFunc _ _ = False

92 isEffFunc _ _ = False

103 -- Check if an expression represents the Monad Eff dictionary

93 -- Check if an expression represents the Monad Eff dictionary

104 isEffDict name (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == name = True

94 isEffDict name (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == name = True

105− isEffDict name (JSApp (JSAccessor prop (JSAccessor eff (JSVar _ps))) [JSObjectLiteral []]) | eff == C.eff &&

95+ isEffDict name (JSApp (JSAccessor prop (JSVar eff)) [JSObjectLiteral []]) = eff == C.eff && prop == name

106− _ps == C._ps &&

107− prop == name = True

108 isEffDict _ _ = False

96 isEffDict _ _ = False

109 -- Remove __do function applications which remain after desugaring

97 -- Remove __do function applications which remain after desugaring

110 undo :: JS -> JS

98 undo :: JS -> JS

@@ -147,9 +135,7 @@ inlineST = everywhere (mkT convertBlock)

147 JSAssignment (JSIndexer i arr) val

135 JSAssignment (JSIndexer i arr) val

148 convert _ other = other

136 convert _ other = other

149 -- Check if an expression represents a function in the ST module

137 -- Check if an expression represents a function in the ST module

150− isSTFunc name (JSAccessor name' (JSAccessor st (JSVar _ps))) | st == C.st &&

138+ isSTFunc name (JSAccessor name' (JSVar st)) = st == C.st && name == name'

151− _ps == C._ps &&

152− name == name' = True

153 isSTFunc _ _ = False

139 isSTFunc _ _ = False

154 -- Find all ST Refs initialized in this block

140 -- Find all ST Refs initialized in this block

155 findSTRefsIn = everything (++) (mkQ [] isSTRef)

141 findSTRefsIn = everything (++) (mkQ [] isSTRef)

src/Language/PureScript/Options.hs+2−2

@@ -48,7 +48,7 @@ data Options = Options {

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

49 -- browser.

50 --

51− , optionsBrowserNamespace :: String

51+ , optionsBrowserNamespace :: Maybe String

52 -- |

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

54 --

@@ -67,4 +67,4 @@ data Options = Options {

67-- Default compiler options

68--

69defaultOptions :: Options

70−defaultOptions = Options False False False False Nothing False "PS" [] [] False

70+defaultOptions = Options False False False False Nothing False Nothing [] [] False

tests/Main.hs+5−4

@@ -54,12 +54,13 @@ assert preludeExterns opts inputFile f = do

54 Just err -> putStrLn err >> exitFailure

55 Nothing -> return ()

57−assertCompiles :: FilePath -> FilePath -> FilePath -> IO ()

57+assertCompiles :: String -> FilePath -> FilePath -> IO ()

58assertCompiles preludeJs preludeExterns inputFile = do

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

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

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

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

62 process <- findNodeProcess

63+ putStrLn $ preludeJs ++ js

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

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

64 case result of

65 case result of

65 Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing

66 Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing

@@ -69,7 +70,7 @@ assertCompiles preludeJs preludeExterns inputFile = do

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

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

70assertDoesNotCompile preludeExterns inputFile = do

71assertDoesNotCompile preludeExterns inputFile = do

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

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

72− assert preludeExterns P.defaultOptions inputFile $ \e ->

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

73 case e of

74 case e of

74 Left _ -> return Nothing

75 Left _ -> return Nothing

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

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

@@ -82,7 +83,7 @@ main :: IO ()

82main = do

83main = do

83 prelude <- preludeFilename

84 prelude <- preludeFilename

84 putStrLn "Compiling Prelude"

85 putStrLn "Compiling Prelude"

85− preludeResult <- compile P.defaultOptions [prelude]

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

86 case preludeResult of

87 case preludeResult of

87 Left err -> putStrLn err >> exitFailure

88 Left err -> putStrLn err >> exitFailure

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

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