-- |
-- Module      :  Cryptol.ModuleSystem.Env
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
module Cryptol.ModuleSystem.Env where

#ifndef RELOCATABLE
import Paths_cryptol (getDataDir)
#endif

import Cryptol.Eval (EvalEnv)
import Cryptol.ModuleSystem.Fingerprint
import Cryptol.ModuleSystem.Interface
import Cryptol.ModuleSystem.Name (Name,Supply,emptySupply)
import qualified Cryptol.ModuleSystem.NamingEnv as R
import Cryptol.Parser.AST
import qualified Cryptol.TypeCheck as T
import qualified Cryptol.TypeCheck.AST as T
import Cryptol.Utils.PP (PP(..),text,parens,NameDisp)

import Data.ByteString(ByteString)
import Control.Monad (guard,mplus)
import qualified Control.Exception as X
import Data.Function (on)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Semigroup
import System.Directory (getAppUserDataDirectory, getCurrentDirectory)
import System.Environment(getExecutablePath)
import System.FilePath ((</>), normalise, joinPath, splitPath, takeDirectory)
import qualified Data.List as List

import GHC.Generics (Generic)
import Control.DeepSeq

import Prelude ()
import Prelude.Compat

import Cryptol.Utils.Panic(panic)
import Cryptol.Utils.PP(pp)

-- Module Environment ----------------------------------------------------------

-- | This is the current state of the interpreter.
data ModuleEnv = ModuleEnv
  { ModuleEnv -> LoadedModules
meLoadedModules :: LoadedModules
    -- ^ Information about all loaded modules.  See 'LoadedModule'.
    -- Contains information such as the file where the module was loaded
    -- from, as well as the module's interface, used for type checking.

  , ModuleEnv -> NameSeeds
meNameSeeds     :: T.NameSeeds
    -- ^ A source of new names for the type checker.

  , ModuleEnv -> SolverConfig
meSolverConfig  :: T.SolverConfig
    -- ^ Configuration settings for the SMT solver used for type-checking.

  , ModuleEnv -> EvalEnv
meEvalEnv       :: EvalEnv
    -- ^ The evaluation environment.  Contains the values for all loaded
    -- modules, both public and private.

  , ModuleEnv -> CoreLint
meCoreLint      :: CoreLint
    -- ^ Should we run the linter to ensure sanity.

  , ModuleEnv -> Bool
meMonoBinds     :: !Bool
    -- ^ Are we assuming that local bindings are monomorphic.
    -- XXX: We should probably remove this flag, and set it to 'True'.



  , ModuleEnv -> Maybe ModName
meFocusedModule :: Maybe ModName
    -- ^ The "current" module.  Used to decide how to print names, for example.

  , ModuleEnv -> [FilePath]
meSearchPath    :: [FilePath]
    -- ^ Where we look for things.

  , ModuleEnv -> DynamicEnv
meDynEnv        :: DynamicEnv
    -- ^ This contains additional definitions that were made at the command
    -- line, and so they don't reside in any module.

  , ModuleEnv -> Supply
meSupply        :: !Supply
    -- ^ Name source for the renamer

  } deriving (forall x. ModuleEnv -> Rep ModuleEnv x)
-> (forall x. Rep ModuleEnv x -> ModuleEnv) -> Generic ModuleEnv
forall x. Rep ModuleEnv x -> ModuleEnv
forall x. ModuleEnv -> Rep ModuleEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModuleEnv x -> ModuleEnv
$cfrom :: forall x. ModuleEnv -> Rep ModuleEnv x
Generic

instance NFData ModuleEnv where
  rnf :: ModuleEnv -> ()
rnf ModuleEnv
x = ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
x LoadedModules -> () -> ()
`seq` ModuleEnv -> EvalEnv
meEvalEnv ModuleEnv
x EvalEnv -> () -> ()
`seq` ModuleEnv -> DynamicEnv
meDynEnv ModuleEnv
x DynamicEnv -> () -> ()
`seq` ()

-- | Should we run the linter?
data CoreLint = NoCoreLint        -- ^ Don't run core lint
              | CoreLint          -- ^ Run core lint
  deriving ((forall x. CoreLint -> Rep CoreLint x)
-> (forall x. Rep CoreLint x -> CoreLint) -> Generic CoreLint
forall x. Rep CoreLint x -> CoreLint
forall x. CoreLint -> Rep CoreLint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CoreLint x -> CoreLint
$cfrom :: forall x. CoreLint -> Rep CoreLint x
Generic, CoreLint -> ()
(CoreLint -> ()) -> NFData CoreLint
forall a. (a -> ()) -> NFData a
rnf :: CoreLint -> ()
$crnf :: CoreLint -> ()
NFData)

resetModuleEnv :: ModuleEnv -> ModuleEnv
resetModuleEnv :: ModuleEnv -> ModuleEnv
resetModuleEnv ModuleEnv
env = ModuleEnv
env
  { meLoadedModules :: LoadedModules
meLoadedModules = LoadedModules
forall a. Monoid a => a
mempty
  , meNameSeeds :: NameSeeds
meNameSeeds     = NameSeeds
T.nameSeeds
  , meEvalEnv :: EvalEnv
meEvalEnv       = EvalEnv
forall a. Monoid a => a
mempty
  , meFocusedModule :: Maybe ModName
meFocusedModule = Maybe ModName
forall a. Maybe a
Nothing
  , meDynEnv :: DynamicEnv
meDynEnv        = DynamicEnv
forall a. Monoid a => a
mempty
  }

initialModuleEnv :: IO ModuleEnv
initialModuleEnv :: IO ModuleEnv
initialModuleEnv = do
  FilePath
curDir <- IO FilePath
getCurrentDirectory
#ifndef RELOCATABLE
  dataDir <- getDataDir
#endif
  FilePath
binDir <- FilePath -> FilePath
takeDirectory (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO FilePath
getExecutablePath
  let instDir :: FilePath
instDir = FilePath -> FilePath
normalise (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
init ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitPath (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
binDir
  -- looking up this directory can fail if no HOME is set, as in some
  -- CI settings
  let handle :: X.IOException -> IO String
      handle :: IOException -> IO FilePath
handle IOException
_e = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
  FilePath
userDir <- IO FilePath -> (IOException -> IO FilePath) -> IO FilePath
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
X.catch (FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"cryptol") IOException -> IO FilePath
handle
  let searchPath :: [FilePath]
searchPath = [ FilePath
curDir
                   -- something like $HOME/.cryptol
                   , FilePath
userDir
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
                   -- ../cryptol on win32
                   , instDir </> "cryptol"
#else
                   -- ../share/cryptol on others
                   , FilePath
instDir FilePath -> FilePath -> FilePath
</> FilePath
"share" FilePath -> FilePath -> FilePath
</> FilePath
"cryptol"
#endif

#ifndef RELOCATABLE
                   -- Cabal-defined data directory. Since this
                   -- is usually a global location like
                   -- /usr/local, search this one last in case
                   -- someone has multiple Cryptols
                   , dataDir
#endif
                   ]

  ModuleEnv -> IO ModuleEnv
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleEnv :: LoadedModules
-> NameSeeds
-> SolverConfig
-> EvalEnv
-> CoreLint
-> Bool
-> Maybe ModName
-> [FilePath]
-> DynamicEnv
-> Supply
-> ModuleEnv
ModuleEnv
    { meLoadedModules :: LoadedModules
meLoadedModules = LoadedModules
forall a. Monoid a => a
mempty
    , meNameSeeds :: NameSeeds
meNameSeeds     = NameSeeds
T.nameSeeds
    , meEvalEnv :: EvalEnv
meEvalEnv       = EvalEnv
forall a. Monoid a => a
mempty
    , meFocusedModule :: Maybe ModName
meFocusedModule = Maybe ModName
forall a. Maybe a
Nothing
      -- we search these in order, taking the first match
    , meSearchPath :: [FilePath]
meSearchPath    = [FilePath]
searchPath
    , meDynEnv :: DynamicEnv
meDynEnv        = DynamicEnv
forall a. Monoid a => a
mempty
    , meMonoBinds :: Bool
meMonoBinds     = Bool
True
    , meSolverConfig :: SolverConfig
meSolverConfig  = SolverConfig :: FilePath -> [FilePath] -> Int -> [FilePath] -> SolverConfig
T.SolverConfig
                          { solverPath :: FilePath
T.solverPath = FilePath
"z3"
                          , solverArgs :: [FilePath]
T.solverArgs = [ FilePath
"-smt2", FilePath
"-in" ]
                          , solverVerbose :: Int
T.solverVerbose = Int
0
                          , solverPreludePath :: [FilePath]
T.solverPreludePath = [FilePath]
searchPath
                          }
    , meCoreLint :: CoreLint
meCoreLint      = CoreLint
NoCoreLint
    , meSupply :: Supply
meSupply        = Supply
emptySupply
    }

-- | Try to focus a loaded module in the module environment.
focusModule :: ModName -> ModuleEnv -> Maybe ModuleEnv
focusModule :: ModName -> ModuleEnv -> Maybe ModuleEnv
focusModule ModName
n ModuleEnv
me = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ModName -> LoadedModules -> Bool
isLoaded ModName
n (ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
me))
  ModuleEnv -> Maybe ModuleEnv
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleEnv
me { meFocusedModule :: Maybe ModName
meFocusedModule = ModName -> Maybe ModName
forall a. a -> Maybe a
Just ModName
n }

-- | Get a list of all the loaded modules. Each module in the
-- resulting list depends only on other modules that precede it.
-- Note that this includes parameterized modules.
loadedModules :: ModuleEnv -> [T.Module]
loadedModules :: ModuleEnv -> [Module]
loadedModules = (LoadedModule -> Module) -> [LoadedModule] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map LoadedModule -> Module
lmModule ([LoadedModule] -> [Module])
-> (ModuleEnv -> [LoadedModule]) -> ModuleEnv -> [Module]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedModules -> [LoadedModule]
getLoadedModules (LoadedModules -> [LoadedModule])
-> (ModuleEnv -> LoadedModules) -> ModuleEnv -> [LoadedModule]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleEnv -> LoadedModules
meLoadedModules

-- | Get a list of all the loaded non-parameterized modules.
-- These are the modules that can be used for evaluation, proving etc.
loadedNonParamModules :: ModuleEnv -> [T.Module]
loadedNonParamModules :: ModuleEnv -> [Module]
loadedNonParamModules = (LoadedModule -> Module) -> [LoadedModule] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map LoadedModule -> Module
lmModule ([LoadedModule] -> [Module])
-> (ModuleEnv -> [LoadedModule]) -> ModuleEnv -> [Module]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedModules -> [LoadedModule]
lmLoadedModules (LoadedModules -> [LoadedModule])
-> (ModuleEnv -> LoadedModules) -> ModuleEnv -> [LoadedModule]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleEnv -> LoadedModules
meLoadedModules

-- | Are any parameterized modules loaded?
hasParamModules :: ModuleEnv -> Bool
hasParamModules :: ModuleEnv -> Bool
hasParamModules = Bool -> Bool
not (Bool -> Bool) -> (ModuleEnv -> Bool) -> ModuleEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LoadedModule] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LoadedModule] -> Bool)
-> (ModuleEnv -> [LoadedModule]) -> ModuleEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedModules -> [LoadedModule]
lmLoadedParamModules (LoadedModules -> [LoadedModule])
-> (ModuleEnv -> LoadedModules) -> ModuleEnv -> [LoadedModule]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleEnv -> LoadedModules
meLoadedModules

allDeclGroups :: ModuleEnv -> [T.DeclGroup]
allDeclGroups :: ModuleEnv -> [DeclGroup]
allDeclGroups = (Module -> [DeclGroup]) -> [Module] -> [DeclGroup]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Module -> [DeclGroup]
T.mDecls ([Module] -> [DeclGroup])
-> (ModuleEnv -> [Module]) -> ModuleEnv -> [DeclGroup]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleEnv -> [Module]
loadedNonParamModules

-- | Contains enough information to browse what's in scope,
-- or type check new expressions.
data ModContext = ModContext
  { ModContext -> IfaceParams
mctxParams          :: IfaceParams
  , ModContext -> IfaceDecls
mctxDecls           :: IfaceDecls
  , ModContext -> NamingEnv
mctxNames           :: R.NamingEnv
  , ModContext -> NameDisp
mctxNameDisp        :: NameDisp
  , ModContext -> Map Name DeclProvenance
mctxTypeProvenace   :: Map Name DeclProvenance
  , ModContext -> Map Name DeclProvenance
mctxValueProvenance :: Map Name DeclProvenance
  }

-- | Specifies how a declared name came to be in scope.
data DeclProvenance =
    NameIsImportedFrom ModName
  | NameIsLocalPublic
  | NameIsLocalPrivate
  | NameIsParameter
  | NameIsDynamicDecl
    deriving (DeclProvenance -> DeclProvenance -> Bool
(DeclProvenance -> DeclProvenance -> Bool)
-> (DeclProvenance -> DeclProvenance -> Bool) -> Eq DeclProvenance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeclProvenance -> DeclProvenance -> Bool
$c/= :: DeclProvenance -> DeclProvenance -> Bool
== :: DeclProvenance -> DeclProvenance -> Bool
$c== :: DeclProvenance -> DeclProvenance -> Bool
Eq,Eq DeclProvenance
Eq DeclProvenance
-> (DeclProvenance -> DeclProvenance -> Ordering)
-> (DeclProvenance -> DeclProvenance -> Bool)
-> (DeclProvenance -> DeclProvenance -> Bool)
-> (DeclProvenance -> DeclProvenance -> Bool)
-> (DeclProvenance -> DeclProvenance -> Bool)
-> (DeclProvenance -> DeclProvenance -> DeclProvenance)
-> (DeclProvenance -> DeclProvenance -> DeclProvenance)
-> Ord DeclProvenance
DeclProvenance -> DeclProvenance -> Bool
DeclProvenance -> DeclProvenance -> Ordering
DeclProvenance -> DeclProvenance -> DeclProvenance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeclProvenance -> DeclProvenance -> DeclProvenance
$cmin :: DeclProvenance -> DeclProvenance -> DeclProvenance
max :: DeclProvenance -> DeclProvenance -> DeclProvenance
$cmax :: DeclProvenance -> DeclProvenance -> DeclProvenance
>= :: DeclProvenance -> DeclProvenance -> Bool
$c>= :: DeclProvenance -> DeclProvenance -> Bool
> :: DeclProvenance -> DeclProvenance -> Bool
$c> :: DeclProvenance -> DeclProvenance -> Bool
<= :: DeclProvenance -> DeclProvenance -> Bool
$c<= :: DeclProvenance -> DeclProvenance -> Bool
< :: DeclProvenance -> DeclProvenance -> Bool
$c< :: DeclProvenance -> DeclProvenance -> Bool
compare :: DeclProvenance -> DeclProvenance -> Ordering
$ccompare :: DeclProvenance -> DeclProvenance -> Ordering
$cp1Ord :: Eq DeclProvenance
Ord)


-- | Given the state of the environment, compute information about what's
-- in scope on the REPL.  This includes what's in the focused module, plus any
-- additional definitions from the REPL (e.g., let bound names, and @it@).
focusedEnv :: ModuleEnv -> ModContext
focusedEnv :: ModuleEnv -> ModContext
focusedEnv ModuleEnv
me =
  ModContext :: IfaceParams
-> IfaceDecls
-> NamingEnv
-> NameDisp
-> Map Name DeclProvenance
-> Map Name DeclProvenance
-> ModContext
ModContext
    { mctxParams :: IfaceParams
mctxParams   = IfaceParams
parameters
    , mctxDecls :: IfaceDecls
mctxDecls    = [IfaceDecls] -> IfaceDecls
forall a. Monoid a => [a] -> a
mconcat (IfaceDecls
dynDecls IfaceDecls -> [IfaceDecls] -> [IfaceDecls]
forall a. a -> [a] -> [a]
: IfaceDecls
localDecls IfaceDecls -> [IfaceDecls] -> [IfaceDecls]
forall a. a -> [a] -> [a]
: [IfaceDecls]
importedDecls)
    , mctxNames :: NamingEnv
mctxNames    = NamingEnv
namingEnv
    , mctxNameDisp :: NameDisp
mctxNameDisp = NamingEnv -> NameDisp
R.toNameDisp NamingEnv
namingEnv
    , mctxTypeProvenace :: Map Name DeclProvenance
mctxTypeProvenace = (Map Name DeclProvenance, Map Name DeclProvenance)
-> Map Name DeclProvenance
forall a b. (a, b) -> a
fst (Map Name DeclProvenance, Map Name DeclProvenance)
provenance
    , mctxValueProvenance :: Map Name DeclProvenance
mctxValueProvenance = (Map Name DeclProvenance, Map Name DeclProvenance)
-> Map Name DeclProvenance
forall a b. (a, b) -> b
snd (Map Name DeclProvenance, Map Name DeclProvenance)
provenance
    }

  where
  ([NamingEnv]
importedNames,[IfaceDecls]
importedDecls,[(Map Name DeclProvenance, Map Name DeclProvenance)]
importedProvs) = [(NamingEnv, IfaceDecls,
  (Map Name DeclProvenance, Map Name DeclProvenance))]
-> ([NamingEnv], [IfaceDecls],
    [(Map Name DeclProvenance, Map Name DeclProvenance)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ((Import
 -> (NamingEnv, IfaceDecls,
     (Map Name DeclProvenance, Map Name DeclProvenance)))
-> [Import]
-> [(NamingEnv, IfaceDecls,
     (Map Name DeclProvenance, Map Name DeclProvenance))]
forall a b. (a -> b) -> [a] -> [b]
map Import
-> (NamingEnv, IfaceDecls,
    (Map Name DeclProvenance, Map Name DeclProvenance))
loadImport [Import]
imports)
  localDecls :: IfaceDecls
localDecls    = IfaceDecls
publicDecls IfaceDecls -> IfaceDecls -> IfaceDecls
forall a. Monoid a => a -> a -> a
`mappend` IfaceDecls
privateDecls
  localNames :: NamingEnv
localNames    = IfaceDecls -> NamingEnv
R.unqualifiedEnv IfaceDecls
localDecls NamingEnv -> NamingEnv -> NamingEnv
forall a. Monoid a => a -> a -> a
`mappend`
                                                IfaceParams -> NamingEnv
R.modParamsNamingEnv IfaceParams
parameters
  dynDecls :: IfaceDecls
dynDecls      = DynamicEnv -> IfaceDecls
deIfaceDecls (ModuleEnv -> DynamicEnv
meDynEnv ModuleEnv
me)
  dynNames :: NamingEnv
dynNames      = DynamicEnv -> NamingEnv
deNames (ModuleEnv -> DynamicEnv
meDynEnv ModuleEnv
me)

  namingEnv :: NamingEnv
namingEnv     = NamingEnv
dynNames   NamingEnv -> NamingEnv -> NamingEnv
`R.shadowing`
                   NamingEnv
localNames NamingEnv -> NamingEnv -> NamingEnv
`R.shadowing`
                   [NamingEnv] -> NamingEnv
forall a. Monoid a => [a] -> a
mconcat [NamingEnv]
importedNames

  provenance :: (Map Name DeclProvenance, Map Name DeclProvenance)
provenance    = [(Map Name DeclProvenance, Map Name DeclProvenance)]
-> (Map Name DeclProvenance, Map Name DeclProvenance)
forall k k a a.
(Ord k, Ord k) =>
[(Map k a, Map k a)] -> (Map k a, Map k a)
shadowProvs
                ([(Map Name DeclProvenance, Map Name DeclProvenance)]
 -> (Map Name DeclProvenance, Map Name DeclProvenance))
-> [(Map Name DeclProvenance, Map Name DeclProvenance)]
-> (Map Name DeclProvenance, Map Name DeclProvenance)
forall a b. (a -> b) -> a -> b
$ DeclProvenance
-> IfaceDecls -> (Map Name DeclProvenance, Map Name DeclProvenance)
forall a. a -> IfaceDecls -> (Map Name a, Map Name a)
declsProv DeclProvenance
NameIsDynamicDecl IfaceDecls
dynDecls
                (Map Name DeclProvenance, Map Name DeclProvenance)
-> [(Map Name DeclProvenance, Map Name DeclProvenance)]
-> [(Map Name DeclProvenance, Map Name DeclProvenance)]
forall a. a -> [a] -> [a]
: DeclProvenance
-> IfaceDecls -> (Map Name DeclProvenance, Map Name DeclProvenance)
forall a. a -> IfaceDecls -> (Map Name a, Map Name a)
declsProv DeclProvenance
NameIsLocalPublic IfaceDecls
publicDecls
                (Map Name DeclProvenance, Map Name DeclProvenance)
-> [(Map Name DeclProvenance, Map Name DeclProvenance)]
-> [(Map Name DeclProvenance, Map Name DeclProvenance)]
forall a. a -> [a] -> [a]
: DeclProvenance
-> IfaceDecls -> (Map Name DeclProvenance, Map Name DeclProvenance)
forall a. a -> IfaceDecls -> (Map Name a, Map Name a)
declsProv DeclProvenance
NameIsLocalPrivate IfaceDecls
privateDecls
                (Map Name DeclProvenance, Map Name DeclProvenance)
-> [(Map Name DeclProvenance, Map Name DeclProvenance)]
-> [(Map Name DeclProvenance, Map Name DeclProvenance)]
forall a. a -> [a] -> [a]
: IfaceParams -> (Map Name DeclProvenance, Map Name DeclProvenance)
paramProv IfaceParams
parameters
                (Map Name DeclProvenance, Map Name DeclProvenance)
-> [(Map Name DeclProvenance, Map Name DeclProvenance)]
-> [(Map Name DeclProvenance, Map Name DeclProvenance)]
forall a. a -> [a] -> [a]
: [(Map Name DeclProvenance, Map Name DeclProvenance)]
importedProvs

  ([Import]
imports, IfaceParams
parameters, IfaceDecls
publicDecls, IfaceDecls
privateDecls) =
    case ModuleEnv -> Maybe ModName
meFocusedModule ModuleEnv
me of
      Maybe ModName
Nothing -> ([Import]
forall a. Monoid a => a
mempty, IfaceParams
noIfaceParams, IfaceDecls
forall a. Monoid a => a
mempty, IfaceDecls
forall a. Monoid a => a
mempty)
      Just ModName
fm ->
        case ModName -> ModuleEnv -> Maybe LoadedModule
lookupModule ModName
fm ModuleEnv
me of
          Just LoadedModule
lm ->
            let Iface { ModName
IfaceDecls
IfaceParams
ifParams :: Iface -> IfaceParams
ifPrivate :: Iface -> IfaceDecls
ifPublic :: Iface -> IfaceDecls
ifModName :: Iface -> ModName
ifParams :: IfaceParams
ifPrivate :: IfaceDecls
ifPublic :: IfaceDecls
ifModName :: ModName
.. } = LoadedModule -> Iface
lmInterface LoadedModule
lm
            in (Module -> [Import]
T.mImports (LoadedModule -> Module
lmModule LoadedModule
lm), IfaceParams
ifParams, IfaceDecls
ifPublic, IfaceDecls
ifPrivate)
          Maybe LoadedModule
Nothing -> FilePath
-> [FilePath] -> ([Import], IfaceParams, IfaceDecls, IfaceDecls)
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic FilePath
"focusedEnv" [FilePath
"Focused module is not loaded."]

  loadImport :: Import
-> (NamingEnv, IfaceDecls,
    (Map Name DeclProvenance, Map Name DeclProvenance))
loadImport Import
imp =
    case ModName -> ModuleEnv -> Maybe LoadedModule
lookupModule (Import -> ModName
iModule Import
imp) ModuleEnv
me of
      Just LoadedModule
lm ->
        let decls :: IfaceDecls
decls = Iface -> IfaceDecls
ifPublic (LoadedModule -> Iface
lmInterface LoadedModule
lm)
        in ( Import -> IfaceDecls -> NamingEnv
R.interpImport Import
imp IfaceDecls
decls
           , IfaceDecls
decls
           , DeclProvenance
-> IfaceDecls -> (Map Name DeclProvenance, Map Name DeclProvenance)
forall a. a -> IfaceDecls -> (Map Name a, Map Name a)
declsProv (ModName -> DeclProvenance
NameIsImportedFrom (Import -> ModName
iModule Import
imp)) IfaceDecls
decls
           )
      Maybe LoadedModule
Nothing -> FilePath
-> [FilePath]
-> (NamingEnv, IfaceDecls,
    (Map Name DeclProvenance, Map Name DeclProvenance))
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic FilePath
"focusedEnv"
                   [ FilePath
"Missing imported module: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Doc -> FilePath
forall a. Show a => a -> FilePath
show (ModName -> Doc
forall a. PP a => a -> Doc
pp (Import -> ModName
iModule Import
imp)) ]


  -- earlier ones shadow
  shadowProvs :: [(Map k a, Map k a)] -> (Map k a, Map k a)
shadowProvs [(Map k a, Map k a)]
ps = let ([Map k a]
tss,[Map k a]
vss) = [(Map k a, Map k a)] -> ([Map k a], [Map k a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Map k a, Map k a)]
ps
                   in ([Map k a] -> Map k a
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map k a]
tss, [Map k a] -> Map k a
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map k a]
vss)

  paramProv :: IfaceParams -> (Map Name DeclProvenance, Map Name DeclProvenance)
paramProv IfaceParams { [Located Prop]
Map Name ModVParam
Map Name ModTParam
ifParamFuns :: IfaceParams -> Map Name ModVParam
ifParamConstraints :: IfaceParams -> [Located Prop]
ifParamTypes :: IfaceParams -> Map Name ModTParam
ifParamFuns :: Map Name ModVParam
ifParamConstraints :: [Located Prop]
ifParamTypes :: Map Name ModTParam
.. } = (Map Name ModTParam -> Map Name DeclProvenance
forall (f :: * -> *) b. Functor f => f b -> f DeclProvenance
doMap Map Name ModTParam
ifParamTypes, Map Name ModVParam -> Map Name DeclProvenance
forall (f :: * -> *) b. Functor f => f b -> f DeclProvenance
doMap Map Name ModVParam
ifParamFuns)
    where doMap :: f b -> f DeclProvenance
doMap f b
mp = DeclProvenance -> b -> DeclProvenance
forall a b. a -> b -> a
const DeclProvenance
NameIsParameter (b -> DeclProvenance) -> f b -> f DeclProvenance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
mp

  declsProv :: a -> IfaceDecls -> (Map Name a, Map Name a)
declsProv a
prov IfaceDecls { Map Name IfaceAbstractType
Map Name IfaceNewtype
Map Name IfaceTySyn
Map Name IfaceDecl
ifDecls :: IfaceDecls -> Map Name IfaceDecl
ifAbstractTypes :: IfaceDecls -> Map Name IfaceAbstractType
ifNewtypes :: IfaceDecls -> Map Name IfaceNewtype
ifTySyns :: IfaceDecls -> Map Name IfaceTySyn
ifDecls :: Map Name IfaceDecl
ifAbstractTypes :: Map Name IfaceAbstractType
ifNewtypes :: Map Name IfaceNewtype
ifTySyns :: Map Name IfaceTySyn
.. } =
    ( [Map Name a] -> Map Name a
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [ Map Name IfaceTySyn -> Map Name a
forall (f :: * -> *) b. Functor f => f b -> f a
doMap Map Name IfaceTySyn
ifTySyns, Map Name IfaceNewtype -> Map Name a
forall (f :: * -> *) b. Functor f => f b -> f a
doMap Map Name IfaceNewtype
ifNewtypes, Map Name IfaceAbstractType -> Map Name a
forall (f :: * -> *) b. Functor f => f b -> f a
doMap Map Name IfaceAbstractType
ifAbstractTypes ]
    , Map Name IfaceDecl -> Map Name a
forall (f :: * -> *) b. Functor f => f b -> f a
doMap Map Name IfaceDecl
ifDecls
    )
    where doMap :: f b -> f a
doMap f b
mp = a -> b -> a
forall a b. a -> b -> a
const a
prov (b -> a) -> f b -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
mp


-- Loaded Modules --------------------------------------------------------------

-- | The location of a module
data ModulePath = InFile FilePath
                | InMem String ByteString -- ^ Label, content
    deriving (Int -> ModulePath -> FilePath -> FilePath
[ModulePath] -> FilePath -> FilePath
ModulePath -> FilePath
(Int -> ModulePath -> FilePath -> FilePath)
-> (ModulePath -> FilePath)
-> ([ModulePath] -> FilePath -> FilePath)
-> Show ModulePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ModulePath] -> FilePath -> FilePath
$cshowList :: [ModulePath] -> FilePath -> FilePath
show :: ModulePath -> FilePath
$cshow :: ModulePath -> FilePath
showsPrec :: Int -> ModulePath -> FilePath -> FilePath
$cshowsPrec :: Int -> ModulePath -> FilePath -> FilePath
Show, (forall x. ModulePath -> Rep ModulePath x)
-> (forall x. Rep ModulePath x -> ModulePath) -> Generic ModulePath
forall x. Rep ModulePath x -> ModulePath
forall x. ModulePath -> Rep ModulePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModulePath x -> ModulePath
$cfrom :: forall x. ModulePath -> Rep ModulePath x
Generic, ModulePath -> ()
(ModulePath -> ()) -> NFData ModulePath
forall a. (a -> ()) -> NFData a
rnf :: ModulePath -> ()
$crnf :: ModulePath -> ()
NFData)

-- | In-memory things are compared by label.
instance Eq ModulePath where
  ModulePath
p1 == :: ModulePath -> ModulePath -> Bool
== ModulePath
p2 =
    case (ModulePath
p1,ModulePath
p2) of
      (InFile FilePath
x, InFile FilePath
y) -> FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
y
      (InMem FilePath
a ByteString
_, InMem FilePath
b ByteString
_) -> FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b
      (ModulePath, ModulePath)
_ -> Bool
False

instance PP ModulePath where
  ppPrec :: Int -> ModulePath -> Doc
ppPrec Int
_ ModulePath
e =
    case ModulePath
e of
      InFile FilePath
p  -> FilePath -> Doc
text FilePath
p
      InMem FilePath
l ByteString
_ -> Doc -> Doc
parens (FilePath -> Doc
text FilePath
l)



-- | The name of the content---either the file path, or the provided label.
modulePathLabel :: ModulePath -> String
modulePathLabel :: ModulePath -> FilePath
modulePathLabel ModulePath
p =
  case ModulePath
p of
    InFile FilePath
path -> FilePath
path
    InMem FilePath
lab ByteString
_ -> FilePath
lab



data LoadedModules = LoadedModules
  { LoadedModules -> [LoadedModule]
lmLoadedModules      :: [LoadedModule]
    -- ^ Invariants:
    -- 1) All the dependencies of any module `m` must precede `m` in the list.
    -- 2) Does not contain any parameterized modules.

  , LoadedModules -> [LoadedModule]
lmLoadedParamModules :: [LoadedModule]
    -- ^ Loaded parameterized modules.

  } deriving (Int -> LoadedModules -> FilePath -> FilePath
[LoadedModules] -> FilePath -> FilePath
LoadedModules -> FilePath
(Int -> LoadedModules -> FilePath -> FilePath)
-> (LoadedModules -> FilePath)
-> ([LoadedModules] -> FilePath -> FilePath)
-> Show LoadedModules
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [LoadedModules] -> FilePath -> FilePath
$cshowList :: [LoadedModules] -> FilePath -> FilePath
show :: LoadedModules -> FilePath
$cshow :: LoadedModules -> FilePath
showsPrec :: Int -> LoadedModules -> FilePath -> FilePath
$cshowsPrec :: Int -> LoadedModules -> FilePath -> FilePath
Show, (forall x. LoadedModules -> Rep LoadedModules x)
-> (forall x. Rep LoadedModules x -> LoadedModules)
-> Generic LoadedModules
forall x. Rep LoadedModules x -> LoadedModules
forall x. LoadedModules -> Rep LoadedModules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoadedModules x -> LoadedModules
$cfrom :: forall x. LoadedModules -> Rep LoadedModules x
Generic, LoadedModules -> ()
(LoadedModules -> ()) -> NFData LoadedModules
forall a. (a -> ()) -> NFData a
rnf :: LoadedModules -> ()
$crnf :: LoadedModules -> ()
NFData)

getLoadedModules :: LoadedModules -> [LoadedModule]
getLoadedModules :: LoadedModules -> [LoadedModule]
getLoadedModules LoadedModules
x = LoadedModules -> [LoadedModule]
lmLoadedParamModules LoadedModules
x [LoadedModule] -> [LoadedModule] -> [LoadedModule]
forall a. [a] -> [a] -> [a]
++ LoadedModules -> [LoadedModule]
lmLoadedModules LoadedModules
x

instance Semigroup LoadedModules where
  LoadedModules
l <> :: LoadedModules -> LoadedModules -> LoadedModules
<> LoadedModules
r = LoadedModules :: [LoadedModule] -> [LoadedModule] -> LoadedModules
LoadedModules
    { lmLoadedModules :: [LoadedModule]
lmLoadedModules = (LoadedModule -> LoadedModule -> Bool)
-> [LoadedModule] -> [LoadedModule] -> [LoadedModule]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
List.unionBy (ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ModName -> ModName -> Bool)
-> (LoadedModule -> ModName)
-> LoadedModule
-> LoadedModule
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LoadedModule -> ModName
lmName)
                                      (LoadedModules -> [LoadedModule]
lmLoadedModules LoadedModules
l) (LoadedModules -> [LoadedModule]
lmLoadedModules LoadedModules
r)
    , lmLoadedParamModules :: [LoadedModule]
lmLoadedParamModules = LoadedModules -> [LoadedModule]
lmLoadedParamModules LoadedModules
l [LoadedModule] -> [LoadedModule] -> [LoadedModule]
forall a. [a] -> [a] -> [a]
++ LoadedModules -> [LoadedModule]
lmLoadedParamModules LoadedModules
r }

instance Monoid LoadedModules where
  mempty :: LoadedModules
mempty = LoadedModules :: [LoadedModule] -> [LoadedModule] -> LoadedModules
LoadedModules { lmLoadedModules :: [LoadedModule]
lmLoadedModules = []
                         , lmLoadedParamModules :: [LoadedModule]
lmLoadedParamModules = []
                         }
  mappend :: LoadedModules -> LoadedModules -> LoadedModules
mappend LoadedModules
l LoadedModules
r = LoadedModules
l LoadedModules -> LoadedModules -> LoadedModules
forall a. Semigroup a => a -> a -> a
<> LoadedModules
r

data LoadedModule = LoadedModule
  { LoadedModule -> ModName
lmName              :: ModName
    -- ^ The name of this module.  Should match what's in 'lmModule'

  , LoadedModule -> ModulePath
lmFilePath          :: ModulePath
    -- ^ The file path used to load this module (may not be canonical)

  , LoadedModule -> FilePath
lmModuleId          :: String
    -- ^ An identifier used to identify the source of the bytes for the module.
    -- For files we just use the cononical path, for in memory things we
    -- use their label.

  , LoadedModule -> Iface
lmInterface         :: Iface
    -- ^ The module's interface. This is for convenient.  At the moment
    -- we have the whole module in 'lmModule', so this could be computer.

  , LoadedModule -> Module
lmModule            :: T.Module
    -- ^ The actual type-checked module

  , LoadedModule -> Fingerprint
lmFingerprint       :: Fingerprint
  } deriving (Int -> LoadedModule -> FilePath -> FilePath
[LoadedModule] -> FilePath -> FilePath
LoadedModule -> FilePath
(Int -> LoadedModule -> FilePath -> FilePath)
-> (LoadedModule -> FilePath)
-> ([LoadedModule] -> FilePath -> FilePath)
-> Show LoadedModule
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [LoadedModule] -> FilePath -> FilePath
$cshowList :: [LoadedModule] -> FilePath -> FilePath
show :: LoadedModule -> FilePath
$cshow :: LoadedModule -> FilePath
showsPrec :: Int -> LoadedModule -> FilePath -> FilePath
$cshowsPrec :: Int -> LoadedModule -> FilePath -> FilePath
Show, (forall x. LoadedModule -> Rep LoadedModule x)
-> (forall x. Rep LoadedModule x -> LoadedModule)
-> Generic LoadedModule
forall x. Rep LoadedModule x -> LoadedModule
forall x. LoadedModule -> Rep LoadedModule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoadedModule x -> LoadedModule
$cfrom :: forall x. LoadedModule -> Rep LoadedModule x
Generic, LoadedModule -> ()
(LoadedModule -> ()) -> NFData LoadedModule
forall a. (a -> ()) -> NFData a
rnf :: LoadedModule -> ()
$crnf :: LoadedModule -> ()
NFData)

-- | Has this module been loaded already.
isLoaded :: ModName -> LoadedModules -> Bool
isLoaded :: ModName -> LoadedModules -> Bool
isLoaded ModName
mn LoadedModules
lm = (LoadedModule -> Bool) -> [LoadedModule] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ModName
mn ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
==) (ModName -> Bool)
-> (LoadedModule -> ModName) -> LoadedModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedModule -> ModName
lmName) (LoadedModules -> [LoadedModule]
getLoadedModules LoadedModules
lm)

-- | Is this a loaded parameterized module.
isLoadedParamMod :: ModName -> LoadedModules -> Bool
isLoadedParamMod :: ModName -> LoadedModules -> Bool
isLoadedParamMod ModName
mn LoadedModules
ln = (LoadedModule -> Bool) -> [LoadedModule] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ModName
mn ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
==) (ModName -> Bool)
-> (LoadedModule -> ModName) -> LoadedModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedModule -> ModName
lmName) (LoadedModules -> [LoadedModule]
lmLoadedParamModules LoadedModules
ln)

-- | Try to find a previously loaded module
lookupModule :: ModName -> ModuleEnv -> Maybe LoadedModule
lookupModule :: ModName -> ModuleEnv -> Maybe LoadedModule
lookupModule ModName
mn ModuleEnv
me = (LoadedModules -> [LoadedModule]) -> Maybe LoadedModule
forall (t :: * -> *).
Foldable t =>
(LoadedModules -> t LoadedModule) -> Maybe LoadedModule
search LoadedModules -> [LoadedModule]
lmLoadedModules Maybe LoadedModule -> Maybe LoadedModule -> Maybe LoadedModule
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (LoadedModules -> [LoadedModule]) -> Maybe LoadedModule
forall (t :: * -> *).
Foldable t =>
(LoadedModules -> t LoadedModule) -> Maybe LoadedModule
search LoadedModules -> [LoadedModule]
lmLoadedParamModules
  where
  search :: (LoadedModules -> t LoadedModule) -> Maybe LoadedModule
search LoadedModules -> t LoadedModule
how = (LoadedModule -> Bool) -> t LoadedModule -> Maybe LoadedModule
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((ModName
mn ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
==) (ModName -> Bool)
-> (LoadedModule -> ModName) -> LoadedModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedModule -> ModName
lmName) (LoadedModules -> t LoadedModule
how (ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
me))


-- | Add a freshly loaded module.  If it was previously loaded, then
-- the new version is ignored.
addLoadedModule ::
  ModulePath -> String -> Fingerprint -> T.Module -> LoadedModules -> LoadedModules
addLoadedModule :: ModulePath
-> FilePath
-> Fingerprint
-> Module
-> LoadedModules
-> LoadedModules
addLoadedModule ModulePath
path FilePath
ident Fingerprint
fp Module
tm LoadedModules
lm
  | ModName -> LoadedModules -> Bool
isLoaded (Module -> ModName
T.mName Module
tm) LoadedModules
lm  = LoadedModules
lm
  | Module -> Bool
T.isParametrizedModule Module
tm = LoadedModules
lm { lmLoadedParamModules :: [LoadedModule]
lmLoadedParamModules = LoadedModule
loaded LoadedModule -> [LoadedModule] -> [LoadedModule]
forall a. a -> [a] -> [a]
:
                                                LoadedModules -> [LoadedModule]
lmLoadedParamModules LoadedModules
lm }
  | Bool
otherwise                = LoadedModules
lm { lmLoadedModules :: [LoadedModule]
lmLoadedModules =
                                          LoadedModules -> [LoadedModule]
lmLoadedModules LoadedModules
lm [LoadedModule] -> [LoadedModule] -> [LoadedModule]
forall a. [a] -> [a] -> [a]
++ [LoadedModule
loaded] }
  where
  loaded :: LoadedModule
loaded = LoadedModule :: ModName
-> ModulePath
-> FilePath
-> Iface
-> Module
-> Fingerprint
-> LoadedModule
LoadedModule
    { lmName :: ModName
lmName            = Module -> ModName
T.mName Module
tm
    , lmFilePath :: ModulePath
lmFilePath        = ModulePath
path
    , lmModuleId :: FilePath
lmModuleId        = FilePath
ident
    , lmInterface :: Iface
lmInterface       = Module -> Iface
genIface Module
tm
    , lmModule :: Module
lmModule          = Module
tm
    , lmFingerprint :: Fingerprint
lmFingerprint     = Fingerprint
fp
    }

-- | Remove a previously loaded module.
-- Note that this removes exactly the modules specified by the predicate.
-- One should be carfule to preserve the invariant on 'LoadedModules'.
removeLoadedModule :: (LoadedModule -> Bool) -> LoadedModules -> LoadedModules
removeLoadedModule :: (LoadedModule -> Bool) -> LoadedModules -> LoadedModules
removeLoadedModule LoadedModule -> Bool
rm LoadedModules
lm =
  LoadedModules :: [LoadedModule] -> [LoadedModule] -> LoadedModules
LoadedModules
    { lmLoadedModules :: [LoadedModule]
lmLoadedModules = (LoadedModule -> Bool) -> [LoadedModule] -> [LoadedModule]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (LoadedModule -> Bool) -> LoadedModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedModule -> Bool
rm) (LoadedModules -> [LoadedModule]
lmLoadedModules LoadedModules
lm)
    , lmLoadedParamModules :: [LoadedModule]
lmLoadedParamModules = (LoadedModule -> Bool) -> [LoadedModule] -> [LoadedModule]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (LoadedModule -> Bool) -> LoadedModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedModule -> Bool
rm) (LoadedModules -> [LoadedModule]
lmLoadedParamModules LoadedModules
lm)
    }

-- Dynamic Environments --------------------------------------------------------

-- | Extra information we need to carry around to dynamically extend
-- an environment outside the context of a single module. Particularly
-- useful when dealing with interactive declarations as in @let@ or
-- @it@.
data DynamicEnv = DEnv
  { DynamicEnv -> NamingEnv
deNames :: R.NamingEnv
  , DynamicEnv -> [DeclGroup]
deDecls :: [T.DeclGroup]
  , DynamicEnv -> EvalEnv
deEnv   :: EvalEnv
  } deriving (forall x. DynamicEnv -> Rep DynamicEnv x)
-> (forall x. Rep DynamicEnv x -> DynamicEnv) -> Generic DynamicEnv
forall x. Rep DynamicEnv x -> DynamicEnv
forall x. DynamicEnv -> Rep DynamicEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DynamicEnv x -> DynamicEnv
$cfrom :: forall x. DynamicEnv -> Rep DynamicEnv x
Generic

instance Semigroup DynamicEnv where
  DynamicEnv
de1 <> :: DynamicEnv -> DynamicEnv -> DynamicEnv
<> DynamicEnv
de2 = DEnv :: NamingEnv -> [DeclGroup] -> EvalEnv -> DynamicEnv
DEnv
    { deNames :: NamingEnv
deNames = DynamicEnv -> NamingEnv
deNames DynamicEnv
de1 NamingEnv -> NamingEnv -> NamingEnv
forall a. Semigroup a => a -> a -> a
<> DynamicEnv -> NamingEnv
deNames DynamicEnv
de2
    , deDecls :: [DeclGroup]
deDecls = DynamicEnv -> [DeclGroup]
deDecls DynamicEnv
de1 [DeclGroup] -> [DeclGroup] -> [DeclGroup]
forall a. Semigroup a => a -> a -> a
<> DynamicEnv -> [DeclGroup]
deDecls DynamicEnv
de2
    , deEnv :: EvalEnv
deEnv   = DynamicEnv -> EvalEnv
deEnv   DynamicEnv
de1 EvalEnv -> EvalEnv -> EvalEnv
forall a. Semigroup a => a -> a -> a
<> DynamicEnv -> EvalEnv
deEnv   DynamicEnv
de2
    }

instance Monoid DynamicEnv where
  mempty :: DynamicEnv
mempty = DEnv :: NamingEnv -> [DeclGroup] -> EvalEnv -> DynamicEnv
DEnv
    { deNames :: NamingEnv
deNames = NamingEnv
forall a. Monoid a => a
mempty
    , deDecls :: [DeclGroup]
deDecls = [DeclGroup]
forall a. Monoid a => a
mempty
    , deEnv :: EvalEnv
deEnv   = EvalEnv
forall a. Monoid a => a
mempty
    }
  mappend :: DynamicEnv -> DynamicEnv -> DynamicEnv
mappend DynamicEnv
de1 DynamicEnv
de2 = DynamicEnv
de1 DynamicEnv -> DynamicEnv -> DynamicEnv
forall a. Semigroup a => a -> a -> a
<> DynamicEnv
de2

-- | Build 'IfaceDecls' that correspond to all of the bindings in the
-- dynamic environment.
--
-- XXX: if we ever add type synonyms or newtypes at the REPL, revisit
-- this.
deIfaceDecls :: DynamicEnv -> IfaceDecls
deIfaceDecls :: DynamicEnv -> IfaceDecls
deIfaceDecls DEnv { deDecls :: DynamicEnv -> [DeclGroup]
deDecls = [DeclGroup]
dgs } =
  [IfaceDecls] -> IfaceDecls
forall a. Monoid a => [a] -> a
mconcat [ IfaceDecls :: Map Name IfaceTySyn
-> Map Name IfaceNewtype
-> Map Name IfaceAbstractType
-> Map Name IfaceDecl
-> IfaceDecls
IfaceDecls
            { ifTySyns :: Map Name IfaceTySyn
ifTySyns   = Map Name IfaceTySyn
forall k a. Map k a
Map.empty
            , ifNewtypes :: Map Name IfaceNewtype
ifNewtypes = Map Name IfaceNewtype
forall k a. Map k a
Map.empty
            , ifAbstractTypes :: Map Name IfaceAbstractType
ifAbstractTypes = Map Name IfaceAbstractType
forall k a. Map k a
Map.empty
            , ifDecls :: Map Name IfaceDecl
ifDecls    = Name -> IfaceDecl -> Map Name IfaceDecl
forall k a. k -> a -> Map k a
Map.singleton (IfaceDecl -> Name
ifDeclName IfaceDecl
ifd) IfaceDecl
ifd
            }
          | Decl
decl <- (DeclGroup -> [Decl]) -> [DeclGroup] -> [Decl]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DeclGroup -> [Decl]
T.groupDecls [DeclGroup]
dgs
          , let ifd :: IfaceDecl
ifd = Decl -> IfaceDecl
mkIfaceDecl Decl
decl
          ]