8b60548 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Merge pull request #3998 from melted/issue3994

Prefer to load imports from the current package

commit8b6054876d987c6d1098524666bc955b51542908 authorNiklas Larsson <metaniklas@gmail.com> dateTue 15 Aug 2017, 22:56 (9 years ago) parent385cf27 3ad2672

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