@@ -5,20 +5,20 @@ Copyright :
5License : BSD3
5License : BSD3
6Maintainer : The Idris Community.
6Maintainer : The Idris Community.
8{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
9{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
9{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
10{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
11+{-# OPTIONS_GHC -fwarn-unused-imports #-}
11module Idris.IBC (loadIBC, loadPkgIndex,
13module Idris.IBC (loadIBC, loadPkgIndex,
12 writeIBC, writePkgIndex,
14 writeIBC, writePkgIndex,
13 hasValidIBCVersion, IBCPhase(..)) where
15 hasValidIBCVersion, IBCPhase(..)) where
15import Idris.AbsSyntax
17import Idris.AbsSyntax
16−import Idris.Core.Binary
17import Idris.Core.CaseTree
18import Idris.Core.CaseTree
18import Idris.Core.Evaluate
19import Idris.Core.Evaluate
19import Idris.Core.TT
20import Idris.Core.TT
20−import Idris.DeepSeq
21+import Idris.DeepSeq ()
21−import Idris.Delaborate
22import Idris.Docstrings (Docstring)
22import Idris.Docstrings (Docstring)
23import qualified Idris.Docstrings as D
23import qualified Idris.Docstrings as D
24import Idris.Error
24import Idris.Error
@@ -27,23 +27,15 @@ import Idris.Options
27import Idris.Output
27import Idris.Output
28import IRTS.System (getIdrisLibDir)
28import IRTS.System (getIdrisLibDir)
32import qualified Cheapskate.Types as CT
30import qualified Cheapskate.Types as CT
33import Codec.Archive.Zip
31import Codec.Archive.Zip
34import Control.DeepSeq
32import Control.DeepSeq
35import Control.Monad
33import Control.Monad
36−import Control.Monad.State.Strict hiding (get, put)
37−import qualified Control.Monad.State.Strict as ST
38import Data.Binary
34import Data.Binary
39import Data.ByteString.Lazy as B hiding (elem, length, map)
35import Data.ByteString.Lazy as B hiding (elem, length, map)
41import Data.List as L
36import Data.List as L
42import Data.Maybe (catMaybes)
37import Data.Maybe (catMaybes)
43import qualified Data.Set as S
38import qualified Data.Set as S
44−import qualified Data.Text as T
45−import Data.Vector.Binary
47import System.Directory
39import System.Directory
48import System.FilePath
40import System.FilePath
@@ -131,7 +123,9 @@ loadIBC :: Bool -- ^ True = reexport, False = make everything private
131 -> IBCPhase
123 -> IBCPhase
132 -> FilePath -> Idris ()
124 -> FilePath -> Idris ()
133loadIBC reexport phase fp
125loadIBC reexport phase fp
126+ = do logIBC 1 $ "loadIBC (reexport, phase, fp)" ++ show (reexport, phase, fp)
134− = do imps <- getImported
127+ imps <- getImported
128+ logIBC 3 $ "loadIBC imps" ++ show imps
135 case lookup fp imps of
129 case lookup fp imps of
136 Nothing -> load True
130 Nothing -> load True
137 Just p -> if (not p && reexport) then load False else return ()
131 Just p -> if (not p && reexport) then load False else return ()
@@ -517,13 +511,15 @@ processImports reexp phase fname ar = do
517 ibcsd <- valIBCSubDir i
511 ibcsd <- valIBCSubDir i
518 ids <- rankedImportDirs fname
512 ids <- rankedImportDirs fname
519 putIState (i { imported = f : imported i })
513 putIState (i { imported = f : imported i })
520− let phase' = case phase of
514+ let (phase', reexp') = case phase of
521− IBC_REPL _ -> IBC_REPL False
515+ IBC_REPL True -> (IBC_REPL False, reexp)
522− p -> p
516+ IBC_REPL False -> (IBC_Building, reexp && re)
517+ p -> (p, reexp && re)
523 fp <- findIBC ids ibcsd f
518 fp <- findIBC ids ibcsd f
519+ logIBC 4 $ "processImports (fp, phase')" ++ show (fp, phase')
524 case fp of
520 case fp of
525 Nothing -> do logIBC 2 $ "Failed to load ibc " ++ f
521 Nothing -> do logIBC 2 $ "Failed to load ibc " ++ f
526− Just fn -> do loadIBC (reexp && re) phase' fn) fs
522+ Just fn -> do loadIBC reexp' phase' fn) fs
528processImplicits :: Archive -> Idris ()
524processImplicits :: Archive -> Idris ()
529processImplicits ar = do
525processImplicits ar = do
@@ -639,6 +635,7 @@ processPatternDefs ar = do
639processDefs :: Archive -> Idris ()
635processDefs :: Archive -> Idris ()
640processDefs ar = do
636processDefs ar = do
641 ds <- getEntry [] "ibc_defs" ar
637 ds <- getEntry [] "ibc_defs" ar
638+ logIBC 4 $ "processDefs ds" ++ show ds
642 mapM_ (\ (n, d) -> do
639 mapM_ (\ (n, d) -> do
643 d' <- updateDef d
640 d' <- updateDef d
644 case d' of
641 case d' of
@@ -735,8 +732,11 @@ processAccess :: Bool -- ^ Reexporting?
735 -> IBCPhase
732 -> IBCPhase
736 -> Archive -> Idris ()
733 -> Archive -> Idris ()
737processAccess reexp phase ar = do
734processAccess reexp phase ar = do
735+ logIBC 3 $ "processAccess (reexp, phase)" ++ show (reexp, phase)
738 ds <- getEntry [] "ibc_access" ar
736 ds <- getEntry [] "ibc_access" ar
737+ logIBC 3 $ "processAccess ds" ++ show ds
739 mapM_ (\ (n, a_in) -> do
738 mapM_ (\ (n, a_in) -> do
740 let a = if reexp then a_in else Hidden
740 let a = if reexp then a_in else Hidden
741 logIBC 3 $ "Setting " ++ show (a, n) ++ " to " ++ show a
741 logIBC 3 $ "Setting " ++ show (a, n) ++ " to " ++ show a
742 updateIState (\i -> i { tt_ctxt = setAccess n a (tt_ctxt i) })
742 updateIState (\i -> i { tt_ctxt = setAccess n a (tt_ctxt i) })
@@ -745,10 +745,15 @@ processAccess reexp phase ar = do
746 logIBC 2 $ "Not exporting " ++ show n
746 logIBC 2 $ "Not exporting " ++ show n
747 setAccessibility n Hidden
747 setAccessibility n Hidden
748− else logIBC 2 $ "Exporting " ++ show n
749+ logIBC 2 $ "Exporting " ++ show n
749 -- Everything should be available at the REPL from
751 -- Everything should be available at the REPL from
750− -- things imported publicly
752+ -- things imported publicly.
753+ when (phase == IBC_REPL True) $ do
754+ logIBC 2 $ "Top level, exporting " ++ show n
751− when (phase == IBC_REPL True) $ setAccessibility n Public) ds
755+ setAccessibility n Public
753processFlags :: Archive -> Idris ()
758processFlags :: Archive -> Idris ()
754processFlags ar = do
759processFlags ar = do