b7dd289 · rowtype-yoga/purescript-native

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

Embed the Prelude. Fix #673

commitb7dd289397434c22e0702d58649205f9b5eac632 authorPhil Freeman <paf31@cantab.net> dateMon 3 Nov 2014, 20:40 (12 years ago) parentff2ddf1

11 files changed+99−121

compare with golang

unifiedsplit

bundle/README−10 bundle/build.sh−1 psc-docs/Main.hs+7−9 psc-make/Main.hs+12−21 psc/Main.hs+13−25 psci/Main.hs+16−8 purescript.cabal+12−8 src/Language/PureScript.hs+14−29 src/Language/PureScript/Parser.hs+1−1 src/Language/PureScript/Parser/Declarations.hs+10 tests/Main.hs+14−9

bundle/README−10

@@ -16,15 +16,5 @@ This bundle contains the following executables:

1616- psci The PureScript interactive module (requires NodeJS)

1717- psc-docs A documentation generator

1818

19−and the following additional files:

20−

21−- prelude.purs The Prelude (standard library source code)

22−

2319Copy these files anywhere on your PATH.

2420

25−The PureScript compiler will look for the Prelude in the following locations:

26−

27−- ~/.purescript/prelude/prelude.purs or

28− C:/Documents And Settings/<user name>/Application Data/purescript/prelude/prelude.purs

29−- The directory of the compiler executable

30−

bundle/build.sh−1

@@ -26,7 +26,6 @@ cp ../dist/build/psc/psc build/purescript/

2626cp ../dist/build/psci/psci build/purescript/

2727cp ../dist/build/psc-make/psc-make build/purescript/

2828cp ../dist/build/psc-docs/psc-docs build/purescript/

29−cp ../prelude/prelude.purs build/purescript/

3029cp README build/purescript/

3130cp ../LICENSE build/purescript/

3231

psc-docs/Main.hs+7−9

@@ -29,19 +29,17 @@ import System.IO (stderr)

2929

3030docgen :: Bool -> [FilePath] -> IO ()

3131docgen showHierarchy input = do

32− ms <- mapM parseFile (nub input)

33− U.putStrLn . runDocs $ (renderModules showHierarchy) (concat ms)

34− exitSuccess

35−

36−parseFile :: FilePath -> IO [P.Module]

37−parseFile input = do

38− text <- U.readFile input

39− case P.runIndentParser input P.parseModules text of

32+ e <- P.parseModulesFromFiles <$> mapM parseFile (nub input)

33+ case e of

4034 Left err -> do

4135 U.hPutStr stderr $ show err

4236 exitFailure

4337 Right ms -> do

44− return ms

38+ U.putStrLn . runDocs $ (renderModules showHierarchy) (map snd ms)

39+ exitSuccess

40+

41+parseFile :: FilePath -> IO (FilePath, String)

42+parseFile input = (,) input <$> U.readFile input

4543

4644type Docs = Writer [String] ()

4745

psc-make/Main.hs+12−21

@@ -12,13 +12,14 @@

1212--

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

1414

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

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

1616

1717module Main where

1818

1919import Control.Applicative

2020import Control.Monad.Error

2121

22+import Data.Bool (bool)

2223import Data.Version (showVersion)

2324

2425import System.Console.CmdTheLine

@@ -28,19 +29,14 @@ import System.FilePath (takeDirectory)

2829import System.Exit (exitSuccess, exitFailure)

2930import System.IO.Error (tryIOError)

3031

31−import Text.Parsec (ParseError)

32−

3332import qualified Language.PureScript as P

3433import qualified Paths_purescript as Paths

3534import qualified System.IO.UTF8 as U

3635

37−readInput :: [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])

38−readInput input = fmap collect $ forM input $ \inputFile -> do

39− text <- U.readFile inputFile

40− return $ (inputFile, P.runIndentParser inputFile P.parseModules text)

41− where

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

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

36+readInput :: Bool -> [FilePath] -> IO [(FilePath, String)]

37+readInput excludePrelude input = do

38+ content <- forM input $ \inputFile -> (inputFile, ) <$> U.readFile inputFile

39+ return $ bool (("<prelude>", P.prelude) :) id excludePrelude content

4440

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

4642

@@ -66,9 +62,9 @@ instance P.MonadMake Make where

6662 liftError = either throwError return

6763 progress = makeIO . U.putStrLn

6864

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

70−compile prelude input outputDir opts usePrefix = do

71− modules <- readInput allInputFiles

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

66+compile input outputDir opts usePrefix = do

67+ modules <- P.parseModulesFromFiles <$> readInput (P.optionsNoPrelude opts) input

7268 case modules of

7369 Left err -> do

7470 U.print err

@@ -86,9 +82,6 @@ compile prelude input outputDir opts usePrefix = do

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

8783 else []

8884

89− allInputFiles | P.optionsNoPrelude opts = input

90− | otherwise = prelude : input

91−

9285mkdirp :: FilePath -> IO ()

9386mkdirp = createDirectoryIfMissing True . takeDirectory

9487

@@ -127,8 +120,8 @@ noPrefix :: Term Bool

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

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

129122

130−term :: FilePath -> Term (IO ())

131−term prelude = compile prelude <$> inputFiles <*> outputDirectory <*> options <*> (not <$> noPrefix)

123+term :: Term (IO ())

124+term = compile <$> inputFiles <*> outputDirectory <*> options <*> (not <$> noPrefix)

132125

133126termInfo :: TermInfo

134127termInfo = defTI

@@ -138,7 +131,5 @@ termInfo = defTI

138131 }

139132

140133main :: IO ()

141−main = do

142− prelude <- P.preludeFilename

143− run (term prelude, termInfo)

134+main = run (term, termInfo)

144135

psc/Main.hs+13−25

@@ -12,13 +12,14 @@

1212--

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

1414

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

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

1616

1717module Main where

1818

1919import Control.Applicative

2020import Control.Monad.Error

2121

22+import Data.Bool (bool)

2223import Data.Version (showVersion)

2324

2425import System.Console.CmdTheLine

@@ -27,26 +28,19 @@ import System.FilePath (takeDirectory)

2728import System.Exit (exitSuccess, exitFailure)

2829import System.IO (stderr)

2930

30−import Text.Parsec (ParseError)

31−

3231import qualified Language.PureScript as P

3332import qualified Paths_purescript as Paths

3433import qualified System.IO.UTF8 as U

3534

36−readInput :: Maybe [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])

37−readInput Nothing = do

38− text <- getContents

39− return $ map ((,) undefined) <$> P.runIndentParser "" P.parseModules text

40−readInput (Just input) = fmap collect $ forM input $ \inputFile -> do

41− text <- U.readFile inputFile

42− return $ (inputFile, P.runIndentParser inputFile P.parseModules text)

43− where

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

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

35+readInput :: Bool -> Bool -> [FilePath] -> IO [(FilePath, String)]

36+readInput _ True _ = return . ("<stdin>" ,) <$> getContents

37+readInput excludePrelude _ input = do

38+ content <- forM input $ \inputFile -> (inputFile, ) <$> U.readFile inputFile

39+ return $ bool (("<prelude>", P.prelude) :) id excludePrelude content

4640

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

48−compile prelude opts stdin input output externs usePrefix = do

49− modules <- readInput stdInOrInputFiles

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

42+compile opts stdin input output externs usePrefix = do

43+ modules <- P.parseModulesFromFiles <$> readInput (P.optionsNoPrelude opts) stdin input

5044 case modules of

5145 Left err -> do

5246 U.hPutStr stderr $ show err

@@ -65,10 +59,6 @@ compile prelude opts stdin input output externs usePrefix = do

6559 Nothing -> return ()

6660 exitSuccess

6761 where

68− stdInOrInputFiles :: Maybe [FilePath]

69− stdInOrInputFiles | stdin = Nothing

70− | P.optionsNoPrelude opts = Just input

71− | otherwise = Just $ prelude : input

7262 prefix = if usePrefix

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

7464 else []

@@ -137,8 +127,8 @@ options = P.Options <$> noPrelude <*> noTco <*> noMagicDo <*> runMain <*> noOpts

137127 where

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

139129

140−term :: FilePath -> Term (IO ())

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

130+term :: Term (IO ())

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

142132

143133termInfo :: TermInfo

144134termInfo = defTI

@@ -148,8 +138,6 @@ termInfo = defTI

148138 }

149139

150140main :: IO ()

151−main = do

152− prelude <- P.preludeFilename

153− run (term prelude, termInfo)

141+main = run (term, termInfo)

154142

155143

psci/Main.hs+16−8

@@ -127,6 +127,17 @@ getHistoryFilename = do

127127loadModule :: FilePath -> IO (Either String [P.Module])

128128loadModule filename = either (Left . show) Right . P.runIndentParser filename P.parseModules <$> U.readFile filename

129129

130+-- |

131+-- Load all modules, including the Prelude

132+--

133+loadAllModules :: [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])

134+loadAllModules files = do

135+ filesAndContent <- forM files $ \filename -> do

136+ content <- U.readFile filename

137+ return (filename, content)

138+ return $ P.parseModulesFromFiles $ ("<prelude>", P.prelude) : filesAndContent

139+

140+

130141-- |

131142-- Expands tilde in path.

132143--

@@ -447,10 +458,9 @@ handleCommand (LoadFile filePath) = do

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

448459handleCommand Reset = do

449460 files <- psciImportedFilenames <$> PSCI (lift get)

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

451− let modulesOrFirstError = fmap concat $ sequence filesAndModules

461+ modulesOrFirstError <- psciIO $ loadAllModules files

452462 case modulesOrFirstError of

453− Left err -> psciIO $ putStrLn err >> exitFailure

463+ Left err -> psciIO $ putStrLn (show err) >> exitFailure

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

455465handleCommand (TypeOf val) = handleTypeOf val

456466handleCommand (KindOf typ) = handleKindOf typ

@@ -489,15 +499,13 @@ loadUserConfig = do

489499loop :: Bool -> [FilePath] -> IO ()

490500loop singleLineMode files = do

491501 config <- loadUserConfig

492− preludeFilename <- P.preludeFilename

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

494− let modulesOrFirstError = fmap concat $ sequence filesAndModules

502+ modulesOrFirstError <- loadAllModules files

495503 case modulesOrFirstError of

496− Left err -> putStrLn err >> exitFailure

504+ Left err -> putStrLn (show err) >> exitFailure

497505 Right modules -> do

498506 historyFilename <- getHistoryFilename

499507 let settings = defaultSettings {historyFile = Just historyFilename}

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

508+ flip evalStateT (PSCiState files defaultImports modules []) . runInputT (setComplete completion settings) $ do

501509 outputStrLn prologueMessage

502510 traverse_ (mapM_ (runPSCI . handleCommand)) config

503511 go

purescript.cabal+12−8

@@ -14,8 +14,6 @@ Homepage: http://www.purescript.org/

1414author: Phil Freeman <paf31@cantab.net>,

1515 Gary Burgess <gary.burgess@gmail.com>,

1616 Hardy Jones <jones3.hardy@gmail.com>

17−data-files: prelude/prelude.purs

18−data-dir: ""

1917

2018extra-source-files: examples/passing/*.purs

2119 , examples/failing/*.purs

@@ -25,14 +23,20 @@ source-repository head

2523 location: https://github.com/purescript/purescript.git

2624

2725library

28− build-depends: base >=4 && <5, cmdtheline == 0.2.*, containers -any, unordered-containers -any,

29− directory >= 1.2, filepath -any, mtl >= 2.1.0 && < 2.3.0, parsec -any,

30− transformers >= 0.3 && < 0.5, utf8-string -any,

26+ build-depends: base >=4 && <5,

27+ cmdtheline == 0.2.*,

28+ containers -any,

29+ unordered-containers -any,

30+ directory >= 1.2,

31+ filepath -any,

32+ mtl >= 2.1.0 && < 2.3.0,

33+ parsec -any,

34+ transformers >= 0.3 && < 0.5,

35+ utf8-string -any,

3136 pattern-arrows >= 0.0.2 && < 0.1,

32− monad-unify >= 0.2.2 && < 0.3,

37+ monad-unify >= 0.2.2 && < 0.3,

38+ file-embed >= 0.0.7 && < 0.0.8,

3339 time -any

34− if (!os(windows))

35− build-depends: unix -any

3640 exposed-modules: Language.PureScript

3741 Language.PureScript.Constants

3842 Language.PureScript.Options

src/Language/PureScript.hs+14−29

@@ -13,9 +13,9 @@

1313--

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

1515

16−{-# LANGUAGE DataKinds #-}

16+{-# LANGUAGE DataKinds, QuasiQuotes, TemplateHaskell #-}

1717

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

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

1919

2020import Language.PureScript.Types as P

2121import Language.PureScript.Kinds as P

@@ -36,21 +36,22 @@ import Language.PureScript.Supply as P

3636import Language.PureScript.Renamer as P

3737

3838import qualified Language.PureScript.Constants as C

39−import qualified Paths_purescript as Paths

4039

4140import Data.List (sortBy, groupBy, intercalate)

4241import Data.Time.Clock

4342import Data.Function (on)

4443import Data.Maybe (fromMaybe)

44+import Data.FileEmbed (embedFile)

45+

4546import Control.Monad.Error

4647import Control.Arrow ((&&&))

4748import Control.Applicative

49+

4850import qualified Data.Map as M

4951import qualified Data.Set as S

52+import qualified Data.ByteString.UTF8 as BU

5053

51−import System.FilePath ((</>), pathSeparator, takeDirectory)

52−import System.Directory (getAppUserDataDirectory, doesFileExist)

53−import System.Environment (getProgName)

54+import System.FilePath ((</>))

5455

5556-- |

5657-- Compile a collection of modules

@@ -146,8 +147,8 @@ make outputDir opts ms prefix = do

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

147148 let filePath = runModuleName moduleName'

148149

149− jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"

150− externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"

150+ jsFile = outputDir </> filePath </> "index.js"

151+ externsFile = outputDir </> filePath </> "externs.purs"

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

152153

153154 jsTimestamp <- getTimestamp jsFile

@@ -173,8 +174,8 @@ make outputDir opts ms prefix = do

173174 go env' ms'

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

175176 let filePath = runModuleName moduleName'

176− jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"

177− externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"

177+ jsFile = outputDir </> filePath </> "index.js"

178+ externsFile = outputDir </> filePath </> "externs.purs"

178179

179180 lift . progress $ "Compiling " ++ runModuleName moduleName'

180181

@@ -201,7 +202,7 @@ make outputDir opts ms prefix = do

201202 toRebuild' = toRebuild `S.union` S.fromList deps

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

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

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

205+ let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"

205206 externs <- readTextFile externsFile

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

207208 case externsModules of

@@ -232,21 +233,5 @@ importPrim = addDefaultImport (ModuleName [ProperName C.prim])

232233importPrelude :: Module -> Module

233234importPrelude = addDefaultImport (ModuleName [ProperName C.prelude])

234235

235−preludeFilename :: IO FilePath

236−preludeFilename = do

237− fs <- sequence [localPrelude, appPrelude, cabalPrelude]

238− es <- filterM doesFileExist fs

239− case es of

240− (x : _) -> return x

241− _ -> error "No Prelude found."

242− where

243− localPrelude :: IO FilePath

244− localPrelude = ((</> "prelude.purs") . takeDirectory) <$> getProgName

245−

246− appPrelude :: IO FilePath

247− appPrelude = do

248− appDir <- getAppUserDataDirectory "purescript"

249− return $ appDir </> "prelude" </> "prelude.purs"

250−

251− cabalPrelude :: IO FilePath

252− cabalPrelude = Paths.getDataFileName "prelude/prelude.purs"

236+prelude :: String

237+prelude = BU.toString $(embedFile "prelude/prelude.purs")

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

@@ -31,4 +31,4 @@ import Language.PureScript.Parser.Common as P

3131import Language.PureScript.Parser.Types as P

3232import Language.PureScript.Parser.State as P

3333import Language.PureScript.Parser.Kinds as P

34−import Language.PureScript.Parser.Declarations as P

34+import Language.PureScript.Parser.Declarations as P

src/Language/PureScript/Parser/Declarations.hs+10

@@ -19,6 +19,7 @@ module Language.PureScript.Parser.Declarations (

1919 parseDeclaration,

2020 parseModule,

2121 parseModules,

22+ parseModulesFromFiles,

2223 parseValue,

2324 parseGuard,

2425 parseBinder,

@@ -26,6 +27,7 @@ module Language.PureScript.Parser.Declarations (

2627) where

2728

2829import Data.Maybe (isJust, fromMaybe)

30+import Data.Traversable (forM)

2931

3032import Control.Applicative

3133import Control.Arrow ((+++))

@@ -230,6 +232,14 @@ parseModule = do

230232 decls <- mark (P.many (same *> parseDeclaration))

231233 return $ Module name decls exports

232234

235+parseModulesFromFiles :: [(FilePath, String)] -> Either P.ParseError [(FilePath, Module)]

236+parseModulesFromFiles input = fmap collect . forM input $ \(filename, content) -> do

237+ ms <- runIndentParser filename parseModules content

238+ return (filename, ms)

239+ where

240+ collect :: [(FilePath, [Module])] -> [(FilePath, Module)]

241+ collect xs = [ (fp, m) | (fp, ms) <- xs, m <- ms ]

242+

233243-- |

234244-- Parse a collection of modules

235245--

tests/Main.hs+14−9

@@ -22,6 +22,7 @@ import Data.List (isSuffixOf)

2222import Data.Traversable (traverse)

2323import Control.Monad

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

25+import Control.Applicative

2526import System.Exit

2627import System.Process

2728import System.FilePath (pathSeparator)

@@ -29,18 +30,24 @@ import System.Directory (getCurrentDirectory, getTemporaryDirectory, getDirector

2930import Text.Parsec (ParseError)

3031import qualified System.IO.UTF8 as U

3132

32−readInput :: [FilePath] -> IO (Either ParseError [P.Module])

33−readInput inputFiles = fmap (fmap concat . sequence) $ forM inputFiles $ \inputFile -> do

33+readInput :: [FilePath] -> IO [(FilePath, String)]

34+readInput inputFiles = forM inputFiles $ \inputFile -> do

3435 text <- U.readFile inputFile

35− return $ P.runIndentParser inputFile P.parseModules text

36+ return (inputFile, text)

37+

38+loadPrelude :: Either String (String, String, P.Environment)

39+loadPrelude =

40+ case P.parseModulesFromFiles [("<prelude>", P.prelude)] of

41+ Left parseError -> Left (show parseError)

42+ Right ms -> P.compile (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) (map snd ms) []

3643

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

3845compile opts inputFiles = do

39− modules <- readInput inputFiles

46+ modules <- P.parseModulesFromFiles <$> readInput inputFiles

4047 case modules of

4148 Left parseError ->

4249 return (Left $ show parseError)

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

50+ Right ms -> return $ P.compile opts (map snd ms) []

4451

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

4653assert preludeExterns opts inputFile f = do

@@ -79,10 +86,8 @@ findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names

7986

8087main :: IO ()

8188main = do

82− prelude <- P.preludeFilename

83− putStrLn "Compiling Prelude"

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

85− case preludeResult of

89+ putStrLn "Compiling Prelude"

90+ case loadPrelude of

8691 Left err -> putStrLn err >> exitFailure

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

8893 tmp <- getTemporaryDirectory