2b04f5a · rowtype-yoga/purescript-native

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

Merge pull request #2417 from kRITZCREEK/text-lexer

Speeds up parsing by reading files as Text

commit2b04f5a2173cd5a183d3a5b9cc979cbdeafc6950 authorPhil Freeman <paf31@cantab.net> dateSat 5 Nov 2016, 23:47 (10 years ago) parent504c77e c144a39

14 files changed+81−57

compare with golang

unifiedsplit

hierarchy/Main.hs+2−2 psc-docs/Main.hs+4−3 psc/Main.hs+4−3 purescript.cabal+4−1 src/Language/PureScript/Docs/ParseAndBookmark.hs+6−7 src/Language/PureScript/Ide/Imports.hs+5−5 src/Language/PureScript/Ide/Rebuild.hs+2−2 src/Language/PureScript/Ide/SourceFile.hs+3−3 src/Language/PureScript/Interactive/Module.hs+3−3 src/Language/PureScript/Parser/Declarations.hs+4−3 src/Language/PureScript/Parser/Lexer.hs+27−19 src/System/IO/UTF8.hs+12−2 tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs+2−2 tests/TestCompiler.hs+3−2

hierarchy/Main.hs+2−2

@@ -33,7 +33,7 @@ import System.FilePath ((</>))

3333import System.FilePath.Glob (glob)

3434import System.Exit (exitFailure, exitSuccess)

3535import System.IO (hPutStr, stderr)

36−import System.IO.UTF8 (readUTF8File)

36+import System.IO.UTF8 (readUTF8FileT)

3737

3838import qualified Language.PureScript as P

3939import qualified Paths_purescript as Paths

@@ -60,7 +60,7 @@ runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)

6060

6161readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])

6262readInput paths = do

63− content <- mapM (\path -> (path, ) <$> readUTF8File path) paths

63+ content <- mapM (\path -> (path, ) <$> readUTF8FileT path) paths

6464 return $ map snd <$> P.parseModulesFromFiles id content

6565

6666compile :: HierarchyOptions -> IO ()

psc-docs/Main.hs+4−3

@@ -7,6 +7,7 @@ import Control.Monad.Trans.Except (runExceptT)

77import Control.Arrow (first, second)

88import Control.Category ((>>>))

99import Control.Monad.Writer

10+import Data.Text (Text)

1011import Data.Function (on)

1112import Data.List

1213import Data.Maybe (fromMaybe)

@@ -20,7 +21,7 @@ import qualified Language.PureScript as P

2021import qualified Paths_purescript as Paths

2122import System.Exit (exitFailure)

2223import System.IO (hPutStrLn, hPrint, hSetEncoding, stderr, stdout, utf8)

23−import System.IO.UTF8 (readUTF8File)

24+import System.IO.UTF8 (readUTF8FileT)

2425import System.Directory (createDirectoryIfMissing)

2526import System.FilePath (takeDirectory)

2627import System.FilePath.Glob (glob)

@@ -139,8 +140,8 @@ dumpTags input renderTags = do

139140 ldump :: [String] -> IO ()

140141 ldump = mapM_ putStrLn

141142

142−parseFile :: FilePath -> IO (FilePath, String)

143−parseFile input = (,) input <$> readUTF8File input

143+parseFile :: FilePath -> IO (FilePath, Text)

144+parseFile input = (,) input <$> readUTF8FileT input

144145

145146inputFile :: Parser FilePath

146147inputFile = strArgument $

psc/Main.hs+4−3

@@ -15,6 +15,7 @@ import Data.Bool (bool)

1515import qualified Data.ByteString.Lazy as B

1616import qualified Data.ByteString.UTF8 as BU8

1717import qualified Data.Map as M

18+import Data.Text (Text)

1819import Data.Version (showVersion)

1920

2021import qualified Language.PureScript as P

@@ -29,7 +30,7 @@ import qualified System.Console.ANSI as ANSI

2930import System.Exit (exitSuccess, exitFailure)

3031import System.FilePath.Glob (glob)

3132import System.IO (hSetEncoding, hPutStrLn, stdout, stderr, utf8)

32−import System.IO.UTF8

33+import System.IO.UTF8 (readUTF8FileT)

3334

3435data PSCMakeOptions = PSCMakeOptions

3536 { pscmInput :: [FilePath]

@@ -85,8 +86,8 @@ globWarningOnMisses warn = concatMapM globWithWarning

8586 return paths

8687 concatMapM f = fmap concat . mapM f

8788

88−readInput :: [FilePath] -> IO [(FilePath, String)]

89−readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8File inFile

89+readInput :: [FilePath] -> IO [(FilePath, Text)]

90+readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8FileT inFile

9091

9192inputFile :: Parser FilePath

9293inputFile = strArgument $

purescript.cabal+4−1

@@ -334,6 +334,7 @@ executable psc

334334 mtl -any,

335335 optparse-applicative >= 0.12.1,

336336 parsec -any,

337+ text -any,

337338 time -any,

338339 transformers -any,

339340 transformers-compat -any,

@@ -387,6 +388,7 @@ executable psc-docs

387388 optparse-applicative >= 0.12.1,

388389 process -any,

389390 split -any,

391+ text -any,

390392 transformers -any,

391393 transformers-compat -any

392394 main-is: Main.hs

@@ -419,7 +421,8 @@ executable psc-hierarchy

419421 mtl -any,

420422 optparse-applicative >= 0.12.1,

421423 parsec -any,

422− process -any

424+ process -any,

425+ text -any

423426 main-is: Main.hs

424427 other-modules: Paths_purescript

425428 buildable: True

src/Language/PureScript/Docs/ParseAndBookmark.hs+6−7

@@ -9,13 +9,12 @@ import Control.Monad.Error.Class (MonadError(..))

99import Control.Monad.IO.Class (MonadIO(..))

1010

1111import qualified Data.Map as M

12+import Data.Text (Text)

1213

1314import Language.PureScript.Docs.Convert (collectBookmarks)

1415import Language.PureScript.Docs.Types

1516import qualified Language.PureScript as P

16−

17−import System.IO.UTF8 (readUTF8File)

18−

17+import System.IO.UTF8 (readUTF8FileT)

1918import Web.Bower.PackageMeta (PackageName)

2019

2120-- |

@@ -45,7 +44,7 @@ parseAndBookmark inputFiles depsFiles = do

4544

4645parseFiles ::

4746 (MonadError P.MultipleErrors m) =>

48− [(FileInfo, FilePath)]

47+ [(FileInfo, Text)]

4948 -> m [(FileInfo, P.Module)]

5049parseFiles =

5150 throwLeft . P.parseModulesFromFiles fileInfoToString

@@ -77,10 +76,10 @@ fileInfoToString :: FileInfo -> FilePath

7776fileInfoToString (Local fn) = fn

7877fileInfoToString (FromDep _ fn) = fn

7978

80−parseFile :: FilePath -> IO (FilePath, String)

81−parseFile input' = (,) input' <$> readUTF8File input'

79+parseFile :: FilePath -> IO (FilePath, Text)

80+parseFile input' = (,) input' <$> readUTF8FileT input'

8281

83−parseAs :: (MonadIO m) => (FilePath -> a) -> FilePath -> m (a, String)

82+parseAs :: (MonadIO m) => (FilePath -> a) -> FilePath -> m (a, Text)

8483parseAs g = fmap (first g) . liftIO . parseFile

8584

8685getDepsModuleNames :: [InPackage (FilePath, P.Module)] -> M.Map P.ModuleName PackageName

src/Language/PureScript/Ide/Imports.hs+5−5

@@ -34,7 +34,6 @@ import Protolude

3434import Control.Lens ((^.))

3535import Data.List (findIndex, nubBy)

3636import qualified Data.Text as T

37−import qualified Data.Text.IO as TIO

3837import qualified Language.PureScript as P

3938import Language.PureScript.Ide.Completion

4039import Language.PureScript.Ide.Error

@@ -42,6 +41,7 @@ import Language.PureScript.Ide.Filter

4241import Language.PureScript.Ide.State

4342import Language.PureScript.Ide.Types

4443import Language.PureScript.Ide.Util

44+import System.IO.UTF8 (readUTF8FileT, writeUTF8FileT)

4545

4646data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName)

4747 deriving (Eq, Show)

@@ -72,7 +72,7 @@ compImport (Import n i q) (Import n' i' q')

7272parseImportsFromFile :: (MonadIO m, MonadError PscIdeError m) =>

7373 FilePath -> m (P.ModuleName, [Text], [Import], [Text])

7474parseImportsFromFile fp = do

75− file <- liftIO (TIO.readFile fp)

75+ file <- liftIO (readUTF8FileT fp)

7676 case sliceImportSection (T.lines file) of

7777 Right res -> pure res

7878 Left err -> throwError (GeneralError err)

@@ -322,10 +322,10 @@ prettyPrintImportSection imports = map prettyPrintImport' (sort imports)

322322answerRequest :: (MonadIO m) => Maybe FilePath -> [Text] -> m Success

323323answerRequest outfp rs =

324324 case outfp of

325− Nothing -> pure $ MultilineTextResult rs

325+ Nothing -> pure (MultilineTextResult rs)

326326 Just outfp' -> do

327− liftIO $ TIO.writeFile outfp' (T.unlines rs)

328− pure $ TextResult $ "Written to " <> T.pack outfp'

327+ liftIO (writeUTF8FileT outfp' (T.unlines rs))

328+ pure (TextResult ("Written to " <> T.pack outfp'))

329329

330330-- | Test and ghci helper

331331parseImport :: Text -> Maybe Import

src/Language/PureScript/Ide/Rebuild.hs+2−2

@@ -21,7 +21,7 @@ import Language.PureScript.Ide.Error

2121import Language.PureScript.Ide.State

2222import Language.PureScript.Ide.Types

2323import Language.PureScript.Ide.Util

24−import System.IO.UTF8 (readUTF8File)

24+import System.IO.UTF8 (readUTF8FileT)

2525

2626-- | Given a filepath performs the following steps:

2727--

@@ -44,7 +44,7 @@ rebuildFile

4444 -> m Success

4545rebuildFile path = do

4646

47− input <- liftIO (readUTF8File path)

47+ input <- liftIO (readUTF8FileT path)

4848

4949 m <- case snd <$> P.parseModuleFromFile identity (path, input) of

5050 Left parseError -> throwError

src/Language/PureScript/Ide/SourceFile.hs+3−3

@@ -30,14 +30,14 @@ import qualified Language.PureScript as P

3030import Language.PureScript.Ide.Error

3131import Language.PureScript.Ide.Types

3232import Language.PureScript.Ide.Util

33−import System.IO.UTF8 (readUTF8File)

33+import System.IO.UTF8 (readUTF8FileT)

3434

3535parseModule

3636 :: (MonadIO m)

3737 => FilePath

38− -> m (Either FilePath (FilePath, P.Module) )

38+ -> m (Either FilePath (FilePath, P.Module))

3939parseModule path = do

40− contents <- liftIO (readUTF8File path)

40+ contents <- liftIO (readUTF8FileT path)

4141 case P.parseModuleFromFile identity (path, contents) of

4242 Left _ -> pure (Left path)

4343 Right m -> pure (Right m)

src/Language/PureScript/Interactive/Module.hs+3−3

@@ -6,7 +6,7 @@ import Control.Monad

66import qualified Language.PureScript as P

77import Language.PureScript.Interactive.Types

88import System.FilePath (pathSeparator)

9−import System.IO.UTF8 (readUTF8File)

9+import System.IO.UTF8 (readUTF8FileT)

1010

1111-- * Support Module

1212

@@ -25,7 +25,7 @@ supportModuleIsDefined = any ((== supportModuleName) . P.getModuleName)

2525--

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

2727loadModule filename = do

28− content <- readUTF8File filename

28+ content <- readUTF8FileT filename

2929 return $ either (Left . P.prettyPrintMultipleErrors P.defaultPPEOptions) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]

3030

3131-- |

@@ -34,7 +34,7 @@ loadModule filename = do

3434loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(FilePath, P.Module)])

3535loadAllModules files = do

3636 filesAndContent <- forM files $ \filename -> do

37− content <- readUTF8File filename

37+ content <- readUTF8FileT filename

3838 return (filename, content)

3939 return $ P.parseModulesFromFiles id filesAndContent

4040

src/Language/PureScript/Parser/Declarations.hs+4−3

@@ -19,6 +19,7 @@ import Prelude hiding (lex)

1919

2020import Data.Functor (($>))

2121import Data.Maybe (fromMaybe)

22+import Data.Text (Text)

2223

2324import Control.Applicative

2425import Control.Arrow ((+++))

@@ -281,7 +282,7 @@ parseModulesFromFiles

281282 :: forall m k

282283 . MonadError MultipleErrors m

283284 => (k -> FilePath)

284− -> [(k, String)]

285+ -> [(k, Text)]

285286 -> m [(k, Module)]

286287parseModulesFromFiles toFilePath input =

287288 flip parU wrapError . inParallel . flip map input $ parseModuleFromFile toFilePath

@@ -298,11 +299,11 @@ parseModulesFromFiles toFilePath input =

298299-- | Parses a single module with FilePath for eventual parsing errors

299300parseModuleFromFile

300301 :: (k -> FilePath)

301− -> (k, String)

302+ -> (k, Text)

302303 -> Either P.ParseError (k, Module)

303304parseModuleFromFile toFilePath (k, content) = do

304305 let filename = toFilePath k

305− ts <- lex filename content

306+ ts <- lex' filename content

306307 m <- runTokenParser filename parseModule ts

307308 pure (k, m)

308309

src/Language/PureScript/Parser/Lexer.hs+27−19

@@ -6,6 +6,7 @@ module Language.PureScript.Parser.Lexer

66 , Token()

77 , TokenParser()

88 , lex

9+ , lex'

910 , anyToken

1011 , token

1112 , match

@@ -69,6 +70,8 @@ import Control.Monad (void, guard)

6970

7071import Data.Char (isSpace, isAscii, isSymbol, isAlphaNum)

7172import Data.Functor.Identity

73+import Data.Text (Text)

74+import qualified Data.Text as T

7275

7376import Language.PureScript.Comments

7477import Language.PureScript.Parser.State

@@ -154,8 +157,13 @@ data PositionedToken = PositionedToken

154157instance Show PositionedToken where

155158 show = prettyPrintToken . ptToken

156159

160+type Lexer u a = P.Parsec Text u a

161+

157162lex :: FilePath -> String -> Either P.ParseError [PositionedToken]

158−lex f s = updatePositions <$> P.parse parseTokens f s

163+lex fp = lex' fp . T.pack

164+

165+lex' :: FilePath -> Text -> Either P.ParseError [PositionedToken]

166+lex' f s = updatePositions <$> P.parse parseTokens f s

159167

160168updatePositions :: [PositionedToken] -> [PositionedToken]

161169updatePositions [] = []

@@ -163,22 +171,22 @@ updatePositions (x:xs) = x : zipWith update (x:xs) xs

163171 where

164172 update PositionedToken { ptEndPos = pos } pt = pt { ptPrevEndPos = Just pos }

165173

166−parseTokens :: P.Parsec String u [PositionedToken]

174+parseTokens :: Lexer u [PositionedToken]

167175parseTokens = whitespace *> P.many parsePositionedToken <* P.skipMany parseComment <* P.eof

168176

169−whitespace :: P.Parsec String u ()

177+whitespace :: Lexer u ()

170178whitespace = P.skipMany (P.satisfy isSpace)

171179

172−parseComment :: P.Parsec String u Comment

180+parseComment :: Lexer u Comment

173181parseComment = (BlockComment <$> blockComment <|> LineComment <$> lineComment) <* whitespace

174182 where

175− blockComment :: P.Parsec String u String

183+ blockComment :: Lexer u String

176184 blockComment = P.try $ P.string "{-" *> P.manyTill P.anyChar (P.try (P.string "-}"))

177185

178− lineComment :: P.Parsec String u String

186+ lineComment :: Lexer u String

179187 lineComment = P.try $ P.string "--" *> P.manyTill P.anyChar (P.try (void (P.char '\n') <|> P.eof))

180188

181−parsePositionedToken :: P.Parsec String u PositionedToken

189+parsePositionedToken :: Lexer u PositionedToken

182190parsePositionedToken = P.try $ do

183191 comments <- P.many parseComment

184192 pos <- P.getPosition

@@ -187,7 +195,7 @@ parsePositionedToken = P.try $ do

187195 whitespace

188196 return $ PositionedToken pos pos' Nothing tok comments

189197

190−parseToken :: P.Parsec String u Token

198+parseToken :: Lexer u Token

191199parseToken = P.choice

192200 [ P.try $ P.string "<-" *> P.notFollowedBy symbolChar *> pure LArrow

193201 , P.try $ P.string "←" *> P.notFollowedBy symbolChar *> pure LArrow

@@ -226,34 +234,34 @@ parseToken = P.choice

226234 ]

227235

228236 where

229− parseLName :: P.Parsec String u String

237+ parseLName :: Lexer u String

230238 parseLName = (:) <$> identStart <*> P.many identLetter

231239

232− parseUName :: P.Parsec String u String

240+ parseUName :: Lexer u String

233241 parseUName = (:) <$> P.upper <*> P.many identLetter

234242

235− parseSymbol :: P.Parsec String u String

243+ parseSymbol :: Lexer u String

236244 parseSymbol = P.many1 symbolChar

237245

238− identStart :: P.Parsec String u Char

246+ identStart :: Lexer u Char

239247 identStart = P.lower <|> P.oneOf "_"

240248

241− identLetter :: P.Parsec String u Char

249+ identLetter :: Lexer u Char

242250 identLetter = P.alphaNum <|> P.oneOf "_'"

243251

244− symbolChar :: P.Parsec String u Char

252+ symbolChar :: Lexer u Char

245253 symbolChar = P.satisfy isSymbolChar

246254

247− parseCharLiteral :: P.Parsec String u Char

255+ parseCharLiteral :: Lexer u Char

248256 parseCharLiteral = PT.charLiteral tokenParser

249257

250− parseStringLiteral :: P.Parsec String u String

258+ parseStringLiteral :: Lexer u String

251259 parseStringLiteral = blockString <|> PT.stringLiteral tokenParser

252260 where

253261 delimiter = P.try (P.string "\"\"\"")

254262 blockString = delimiter >> P.manyTill P.anyChar delimiter

255263

256− parseNumber :: P.Parsec String u (Either Integer Double)

264+ parseNumber :: Lexer u (Either Integer Double)

257265 parseNumber = (consumeLeadingZero >> P.parserZero) <|>

258266 (Right <$> P.try (PT.float tokenParser) <|>

259267 Left <$> P.try (PT.natural tokenParser))

@@ -267,7 +275,7 @@ parseToken = P.choice

267275-- |

268276-- We use Text.Parsec.Token to implement the string and number lexemes

269277--

270−langDef :: PT.GenLanguageDef String u Identity

278+langDef :: PT.GenLanguageDef Text u Identity

271279langDef = PT.LanguageDef

272280 { PT.reservedNames = []

273281 , PT.reservedOpNames = []

@@ -285,7 +293,7 @@ langDef = PT.LanguageDef

285293-- |

286294-- A token parser based on the language definition

287295--

288−tokenParser :: PT.GenTokenParser String u Identity

296+tokenParser :: PT.GenTokenParser Text u Identity

289297tokenParser = PT.makeTokenParser langDef

290298

291299type TokenParser a = P.Parsec [PositionedToken] ParseState a

src/System/IO/UTF8.hs+12−2

@@ -4,11 +4,21 @@ import Prelude.Compat

55import qualified Data.ByteString as BS

66import qualified Data.ByteString.UTF8 as UTF8

7+import Data.Text (Text)

8+import qualified Data.Text.Encoding as TE

10+readUTF8FileT :: FilePath -> IO Text

11+readUTF8FileT inFile =

12+ fmap TE.decodeUtf8 (BS.readFile inFile)

13+

14+writeUTF8FileT :: FilePath -> Text -> IO ()

15+writeUTF8FileT inFile text =

16+ BS.writeFile inFile (TE.encodeUtf8 text)

717

818readUTF8File :: FilePath -> IO String

9−readUTF8File inFile = do

19+readUTF8File inFile =

1020 fmap UTF8.toString (BS.readFile inFile)

1121

1222writeUTF8File :: FilePath -> String -> IO ()

13−writeUTF8File inFile text = do

23+writeUTF8File inFile text =

1424 BS.writeFile inFile (UTF8.fromString text)

tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs+2−2

@@ -6,12 +6,12 @@ module Language.PureScript.Ide.Imports.IntegrationSpec where

66import Protolude

88import qualified Data.Text as T

9−import qualified Data.Text.IO as TIO

109import qualified Language.PureScript.Ide.Integration as Integration

1110import Test.Hspec

1211

1312import System.Directory

1413import System.FilePath

14+import System.IO.UTF8 (readUTF8FileT)

1515

1616setup :: IO ()

1717setup = void (Integration.reset *> Integration.loadAll)

@@ -27,7 +27,7 @@ withSupportFiles test = do

2727outputFileShouldBe :: [Text] -> IO ()

2828outputFileShouldBe expectation = do

2929 outFp <- (</> "src" </> "ImportsSpecOut.tmp") <$> Integration.projectDirectory

30− outRes <- TIO.readFile outFp

30+ outRes <- readUTF8FileT outFp

3131 shouldBe (T.lines outRes) expectation

3232

3333spec :: Spec

tests/TestCompiler.hs+3−2

@@ -31,6 +31,7 @@ import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy, minimumBy)

3131import Data.Maybe (mapMaybe)

3232import Data.Time.Clock (UTCTime())

3333import Data.Tuple (swap)

34+import qualified Data.Text as T

3435

3536import qualified Data.Map as M

3637

@@ -71,7 +72,7 @@ spec = do

7172 supportPurs <- supportFiles "purs"

7273 supportPursFiles <- readInput supportPurs

7374 supportExterns <- runExceptT $ do

74− modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles

75+ modules <- ExceptT . return $ P.parseModulesFromFiles id (map (fmap T.pack) supportPursFiles)

7576 foreigns <- inferForeignModules modules

7677 externs <- ExceptT . fmap fst . runTest $ P.make (makeActions foreigns) (map snd modules)

7778 return (zip (map snd modules) externs)

@@ -194,7 +195,7 @@ compile

194195 -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)

195196compile supportExterns inputFiles check = silence $ runTest $ do

196197 fs <- liftIO $ readInput inputFiles

197− ms <- P.parseModulesFromFiles id fs

198+ ms <- P.parseModulesFromFiles id (map (fmap T.pack) fs)

198199 foreigns <- inferForeignModules ms

199200 liftIO (check (map snd ms))

200201 let actions = makeActions foreigns