3ad2672 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Prefer to load imports from the current package

This is done by moving import dirs that are prefixes to the current path to the front of the import dir list. Also make a fuction that only looks for IBCs. Both these changes should be helpful for performance. Fixes #3994

commit3ad2672caee4950de19fec4c5b5ba46413d58904 authorNiklas Larsson <niklas@mm.st> dateTue 15 Aug 2017, 19:44 (9 years ago) parentebd2e6f

5 files changed+39−26

compare with master

unifiedsplit

src/IRTS/Compiler.hs+1−1 src/Idris/AbsSyntax.hs+8 src/Idris/IBC.hs+15−22 src/Idris/Imports.hs+13−1 src/Idris/Parser.hs+2−2

src/IRTS/Compiler.hs+1−1

@@ -76,7 +76,7 @@ compile codegen f mtm = do

7676 libs <- getLibs codegen

7777 flags <- getFlags codegen

7878 hdrs <- getHdrs codegen

79− impdirs <- allImportDirs

79+ impdirs <- rankedImportDirs f

8080 ttDeclarations <- getDeclarations reachableNames

8181 defsIn <- mkDecls reachableNames

8282 -- if no 'main term' given, generate interface files

src/Idris/AbsSyntax.hs+8

@@ -1108,6 +1108,14 @@ allImportDirs = do i <- getIState

11081108 let optdirs = opt_importdirs (idris_options i)

11091109 return ("." : reverse optdirs)

11101110

1111+-- Like allImportDirs but the dirs that are a prefix of

1112+-- the files path first. This makes it look in the current

1113+-- package first.

1114+rankedImportDirs :: FilePath -> Idris [FilePath]

1115+rankedImportDirs fp = do ids <- allImportDirs

1116+ let (prefixes, rest) = partition (`isPrefixOf`fp) ids

1117+ return $ prefixes ++ rest

1118+

11111119addSourceDir :: FilePath -> Idris ()

11121120addSourceDir fp = do i <- getIState

11131121 let opts = idris_options i

src/Idris/IBC.hs+15−22

@@ -146,7 +146,7 @@ loadIBC reexport phase fp

146146 Right archive -> do

147147 if fullLoad

148148 then process reexport phase archive fp

149− else unhide phase archive

149+ else unhide phase fp archive

150150 addImported reexport fp

151151

152152-- | Load an entire package from its index file

@@ -359,9 +359,9 @@ getEntry alt f a = case findEntryByPath f a of

359359 Nothing -> return alt

360360 Just e -> return $! (force . decode . fromEntry) e

361361

362−unhide :: IBCPhase -> Archive -> Idris ()

363−unhide phase ar = do

364− processImports True phase ar

362+unhide :: IBCPhase -> FilePath -> Archive -> Idris ()

363+unhide phase fp ar = do

364+ processImports True phase fp ar

365365 processAccess True phase ar

366366

367367process :: Bool -- ^ Reexporting

@@ -393,7 +393,7 @@ process reexp phase archive fn = do

393393 when srcok $ timestampOlder source fn

394394 processImportDirs archive

395395 processSourceDirs archive

396− processImports reexp phase archive

396+ processImports reexp phase fn archive

397397 processImplicits archive

398398 processInfix archive

399399 processStatics archive

@@ -405,7 +405,7 @@ process reexp phase archive fn = do

405405 processOptimise archive

406406 processSyntax archive

407407 processKeywords archive

408− processObjectFiles archive

408+ processObjectFiles fn archive

409409 processLibs archive

410410 processCodegenFlags archive

411411 processDynamicLibs archive

@@ -509,28 +509,21 @@ processSourceDirs ar = do

509509 fs <- getEntry [] "ibc_sourcedirs" ar

510510 mapM_ addSourceDir fs

511511

512−processImports :: Bool -> IBCPhase -> Archive -> Idris ()

513−processImports reexp phase ar = do

512+processImports :: Bool -> IBCPhase -> FilePath -> Archive -> Idris ()

513+processImports reexp phase fname ar = do

514514 fs <- getEntry [] "ibc_imports" ar

515515 mapM_ (\(re, f) -> do

516516 i <- getIState

517517 ibcsd <- valIBCSubDir i

518− ids <- allImportDirs

519− fp <- findImport ids ibcsd f

520−-- if (f `elem` imported i)

521−-- then logLvl 1 $ "Already read " ++ f

518+ ids <- rankedImportDirs fname

522519 putIState (i { imported = f : imported i })

523520 let phase' = case phase of

524521 IBC_REPL _ -> IBC_REPL False

525522 p -> p

523+ fp <- findIBC ids ibcsd f

526524 case fp of

527− LIDR fn -> do

528− logIBC 2 $ "Failed at " ++ fn

529− ifail "Must be an ibc"

530− IDR fn -> do

531− logIBC 2 $ "Failed at " ++ fn

532− ifail "Must be an ibc"

533− IBC fn src -> loadIBC (reexp && re) phase' fn) fs

525+ Nothing -> do logIBC 2 $ "Failed to load ibc " ++ f

526+ Just fn -> do loadIBC (reexp && re) phase' fn) fs

534527

535528processImplicits :: Archive -> Idris ()

536529processImplicits ar = do

@@ -605,11 +598,11 @@ processKeywords ar = do

605598 k <- getEntry [] "ibc_keywords" ar

606599 updateIState (\i -> i { syntax_keywords = k ++ syntax_keywords i })

607600

608−processObjectFiles :: Archive -> Idris ()

609−processObjectFiles ar = do

601+processObjectFiles :: FilePath -> Archive -> Idris ()

602+processObjectFiles fn ar = do

610603 os <- getEntry [] "ibc_objs" ar

611604 mapM_ (\ (cg, obj) -> do

612− dirs <- allImportDirs

605+ dirs <- rankedImportDirs fn

613606 o <- runIO $ findInPath dirs obj

614607 addObjectFile cg o) os

615608

src/Idris/Imports.hs+13−1

@@ -6,13 +6,14 @@ License : BSD3

66Maintainer : The Idris Community.

77-}

88module Idris.Imports(

9− IFileType(..), findImport, findInPath, findPkgIndex

9+ IFileType(..), findIBC, findImport, findInPath, findPkgIndex

1010 , ibcPathNoFallback, installedPackages, pkgIndex

1111 ) where

1212

1313import Idris.AbsSyntax

1414import Idris.Core.TT

1515import Idris.Error

16+import Idris.Output

1617import IRTS.System (getIdrisLibDir)

1718

1819import Control.Applicative ((<$>))

@@ -77,6 +78,17 @@ findImport (d:ds) ibcsd fp = do let fp_full = d </> fp

7778 then return isrc

7879 else findImport ds ibcsd fp

7980

81+-- Only look for IBCs and not source

82+findIBC :: [FilePath] -> FilePath -> FilePath -> Idris (Maybe FilePath)

83+findIBC [] _ fp = return Nothing

84+findIBC (d:ds) ibcsd fp = do let fp_full = d </> fp

85+ ibcp <- runIO $ ibcPathWithFallback ibcsd fp_full

86+ ibc <- runIO $ doesFileExist' ibcp

87+ if ibc

88+ then return $ Just ibcp

89+ else findIBC ds ibcsd fp

90+

91+

8092-- find a specific filename somewhere in a path

8193

8294findInPath :: [FilePath] -> FilePath -> IO FilePath

src/Idris/Parser.hs+2−2

@@ -1664,7 +1664,7 @@ loadModule' f phase

16641664 = do i <- getIState

16651665 let file = takeWhile (/= ' ') f

16661666 ibcsd <- valIBCSubDir i

1667− ids <- allImportDirs

1667+ ids <- rankedImportDirs file

16681668 fp <- findImport ids ibcsd file

16691669 if file `elem` imported i

16701670 then do logParser 1 $ "Already read " ++ file

@@ -1717,7 +1717,7 @@ loadSource lidr f toline

17171717 (mdocs, mname, imports_in, pos) <- parseImports f file

17181718 ai <- getAutoImports

17191719 let imports = map (\n -> ImportInfo True n Nothing [] NoFC NoFC) ai ++ imports_in

1720− ids <- allImportDirs

1720+ ids <- rankedImportDirs f

17211721 ibcsd <- valIBCSubDir i

17221722 mapM_ (\(re, f, ns, nfc) ->

17231723 do fp <- findImport ids ibcsd f