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

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BlockArguments #-}
module Cryptol.ModuleSystem.Monad where

import           Cryptol.Eval (EvalEnv,EvalOpts(..))

import           Cryptol.Backend.FFI (ForeignSrc)
import           Cryptol.Backend.FFI.Error
import qualified Cryptol.Backend.Monad           as E

import           Cryptol.ModuleSystem.Env
import qualified Cryptol.ModuleSystem.Env as MEnv
import           Cryptol.ModuleSystem.Interface
import           Cryptol.ModuleSystem.Name (FreshM(..),Supply)
import           Cryptol.ModuleSystem.Renamer (RenamerError(),RenamerWarning())
import           Cryptol.ModuleSystem.NamingEnv(NamingEnv)
import qualified Cryptol.Parser     as Parser
import qualified Cryptol.Parser.AST as P
import           Cryptol.Utils.Panic (panic)
import qualified Cryptol.Parser.NoPat as NoPat
import qualified Cryptol.Parser.ExpandPropGuards as ExpandPropGuards
import qualified Cryptol.Parser.NoInclude as NoInc
import qualified Cryptol.TypeCheck as T
import qualified Cryptol.TypeCheck.AST as T
import qualified Cryptol.TypeCheck.Solver.SMT as SMT

import           Cryptol.Parser.Position (Range, Located)
import           Cryptol.Utils.Ident (interactiveName, noModuleName)
import           Cryptol.Utils.PP
import           Cryptol.Utils.Logger(Logger)

import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class
import Control.Exception (IOException)
import Data.ByteString (ByteString)
import Data.Function (on)
import Data.Functor.Identity
import Data.Map (Map)
import Data.Text.Encoding.Error (UnicodeException)
import Data.Traversable
import MonadLib
import System.Directory (canonicalizePath)

import GHC.Generics (Generic)
import Control.DeepSeq

import Prelude ()
import Prelude.Compat


-- Errors ----------------------------------------------------------------------

data ImportSource
  = FromModule P.ModName
  | FromImport (Located P.Import)
  | FromSigImport (Located P.ModName)
  | FromModuleInstance (Located P.ModName)
    deriving (Int -> ImportSource -> ShowS
[ImportSource] -> ShowS
ImportSource -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ImportSource] -> ShowS
$cshowList :: [ImportSource] -> ShowS
show :: ImportSource -> [Char]
$cshow :: ImportSource -> [Char]
showsPrec :: Int -> ImportSource -> ShowS
$cshowsPrec :: Int -> ImportSource -> ShowS
Show, forall x. Rep ImportSource x -> ImportSource
forall x. ImportSource -> Rep ImportSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportSource x -> ImportSource
$cfrom :: forall x. ImportSource -> Rep ImportSource x
Generic, ImportSource -> ()
forall a. (a -> ()) -> NFData a
rnf :: ImportSource -> ()
$crnf :: ImportSource -> ()
NFData)

instance Eq ImportSource where
  == :: ImportSource -> ImportSource -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportSource -> ModName
importedModule

instance PP ImportSource where
  ppPrec :: Int -> ImportSource -> Doc
ppPrec Int
_ ImportSource
is = case ImportSource
is of
    FromModule ModName
n  -> [Char] -> Doc
text [Char]
"module name" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModName
n
    FromImport Located Import
li -> [Char] -> Doc
text [Char]
"import of module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall mname. ImportG mname -> mname
P.iModule (forall a. Located a -> a
P.thing Located Import
li))
    FromSigImport Located ModName
l -> [Char] -> Doc
text [Char]
"import of interface" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
P.thing Located ModName
l)
    FromModuleInstance Located ModName
l ->
      [Char] -> Doc
text [Char]
"instantiation of module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
P.thing Located ModName
l)

importedModule :: ImportSource -> P.ModName
importedModule :: ImportSource -> ModName
importedModule ImportSource
is =
  case ImportSource
is of
    FromModule ModName
n          -> ModName
n
    FromImport Located Import
li         -> forall mname. ImportG mname -> mname
P.iModule (forall a. Located a -> a
P.thing Located Import
li)
    FromModuleInstance Located ModName
l  -> forall a. Located a -> a
P.thing Located ModName
l
    FromSigImport Located ModName
l       -> forall a. Located a -> a
P.thing Located ModName
l


data ModuleError
  = ModuleNotFound P.ModName [FilePath]
    -- ^ Unable to find the module given, tried looking in these paths
  | CantFindFile FilePath
    -- ^ Unable to open a file
  | BadUtf8 ModulePath UnicodeException
    -- ^ Bad UTF-8 encoding in while decoding this file
  | OtherIOError FilePath IOException
    -- ^ Some other IO error occurred while reading this file
  | ModuleParseError ModulePath Parser.ParseError
    -- ^ Generated this parse error when parsing the file for module m
  | RecursiveModules [ImportSource]
    -- ^ Recursive module group discovered
  | RenamerErrors ImportSource [RenamerError]
    -- ^ Problems during the renaming phase
  | NoPatErrors ImportSource [NoPat.Error]
    -- ^ Problems during the NoPat phase
  | ExpandPropGuardsError ImportSource ExpandPropGuards.Error
    -- ^ Problems during the ExpandPropGuards phase
  | NoIncludeErrors ImportSource [NoInc.IncludeError]
    -- ^ Problems during the NoInclude phase
  | TypeCheckingFailed ImportSource T.NameMap [(Range,T.Error)]
    -- ^ Problems during type checking
  | OtherFailure String
    -- ^ Problems after type checking, eg. specialization
  | ModuleNameMismatch P.ModName (Located P.ModName)
    -- ^ Module loaded by 'import' statement has the wrong module name
  | DuplicateModuleName P.ModName FilePath FilePath
    -- ^ Two modules loaded from different files have the same module name
  | FFILoadErrors P.ModName [FFILoadError]
    -- ^ Errors loading foreign function implementations

  | ErrorInFile ModulePath ModuleError
    -- ^ This is just a tag on the error, indicating the file containing it.
    -- It is convenient when we had to look for the module, and we'd like
    -- to communicate the location of pthe problematic module to the handler.

    deriving (Int -> ModuleError -> ShowS
[ModuleError] -> ShowS
ModuleError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ModuleError] -> ShowS
$cshowList :: [ModuleError] -> ShowS
show :: ModuleError -> [Char]
$cshow :: ModuleError -> [Char]
showsPrec :: Int -> ModuleError -> ShowS
$cshowsPrec :: Int -> ModuleError -> ShowS
Show)

instance NFData ModuleError where
  rnf :: ModuleError -> ()
rnf ModuleError
e = case ModuleError
e of
    ModuleNotFound ModName
src [[Char]]
path              -> ModName
src forall a b. NFData a => a -> b -> b
`deepseq` [[Char]]
path forall a b. NFData a => a -> b -> b
`deepseq` ()
    CantFindFile [Char]
path                    -> [Char]
path forall a b. NFData a => a -> b -> b
`deepseq` ()
    BadUtf8 ModulePath
path UnicodeException
ue                      -> forall a. NFData a => a -> ()
rnf (ModulePath
path, UnicodeException
ue)
    OtherIOError [Char]
path IOException
exn                -> [Char]
path forall a b. NFData a => a -> b -> b
`deepseq` IOException
exn seq :: forall a b. a -> b -> b
`seq` ()
    ModuleParseError ModulePath
source ParseError
err          -> ModulePath
source forall a b. NFData a => a -> b -> b
`deepseq` ParseError
err forall a b. NFData a => a -> b -> b
`deepseq` ()
    RecursiveModules [ImportSource]
mods                -> [ImportSource]
mods forall a b. NFData a => a -> b -> b
`deepseq` ()
    RenamerErrors ImportSource
src [RenamerError]
errs               -> ImportSource
src forall a b. NFData a => a -> b -> b
`deepseq` [RenamerError]
errs forall a b. NFData a => a -> b -> b
`deepseq` ()
    NoPatErrors ImportSource
src [Error]
errs                 -> ImportSource
src forall a b. NFData a => a -> b -> b
`deepseq` [Error]
errs forall a b. NFData a => a -> b -> b
`deepseq` ()
    ExpandPropGuardsError ImportSource
src Error
err        -> ImportSource
src forall a b. NFData a => a -> b -> b
`deepseq` Error
err forall a b. NFData a => a -> b -> b
`deepseq` ()
    NoIncludeErrors ImportSource
src [IncludeError]
errs             -> ImportSource
src forall a b. NFData a => a -> b -> b
`deepseq` [IncludeError]
errs forall a b. NFData a => a -> b -> b
`deepseq` ()
    TypeCheckingFailed ImportSource
nm NameMap
src [(Range, Error)]
errs       -> ImportSource
nm forall a b. NFData a => a -> b -> b
`deepseq` NameMap
src forall a b. NFData a => a -> b -> b
`deepseq` [(Range, Error)]
errs forall a b. NFData a => a -> b -> b
`deepseq` ()
    ModuleNameMismatch ModName
expected Located ModName
found    ->
      ModName
expected forall a b. NFData a => a -> b -> b
`deepseq` Located ModName
found forall a b. NFData a => a -> b -> b
`deepseq` ()
    DuplicateModuleName ModName
name [Char]
path1 [Char]
path2 ->
      ModName
name forall a b. NFData a => a -> b -> b
`deepseq` [Char]
path1 forall a b. NFData a => a -> b -> b
`deepseq` [Char]
path2 forall a b. NFData a => a -> b -> b
`deepseq` ()
    OtherFailure [Char]
x                       -> [Char]
x forall a b. NFData a => a -> b -> b
`deepseq` ()
    FFILoadErrors ModName
x [FFILoadError]
errs                 -> ModName
x forall a b. NFData a => a -> b -> b
`deepseq` [FFILoadError]
errs forall a b. NFData a => a -> b -> b
`deepseq` ()
    ErrorInFile ModulePath
x ModuleError
y                      -> ModulePath
x forall a b. NFData a => a -> b -> b
`deepseq` ModuleError
y forall a b. NFData a => a -> b -> b
`deepseq` ()

instance PP ModuleError where
  ppPrec :: Int -> ModuleError -> Doc
ppPrec Int
prec ModuleError
e = case ModuleError
e of

    ModuleNotFound ModName
src [[Char]]
path ->
      [Char] -> Doc
text [Char]
"[error]" Doc -> Doc -> Doc
<+>
      [Char] -> Doc
text [Char]
"Could not find module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModName
src
      Doc -> Doc -> Doc
$$
      Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"Searched paths:")
         Int
4 ([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc
text [[Char]]
path))
      Doc -> Doc -> Doc
$$
      [Char] -> Doc
text [Char]
"Set the CRYPTOLPATH environment variable to search more directories"

    CantFindFile [Char]
path ->
      [Char] -> Doc
text [Char]
"[error]" Doc -> Doc -> Doc
<+>
      [Char] -> Doc
text [Char]
"can't find file:" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
path

    BadUtf8 ModulePath
path UnicodeException
_ue ->
      [Char] -> Doc
text [Char]
"[error]" Doc -> Doc -> Doc
<+>
      [Char] -> Doc
text [Char]
"bad utf-8 encoding:" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModulePath
path

    OtherIOError [Char]
path IOException
exn ->
      Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"[error]" Doc -> Doc -> Doc
<+>
            [Char] -> Doc
text [Char]
"IO error while loading file:" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
path Doc -> Doc -> Doc
<.> Doc
colon)
         Int
4 ([Char] -> Doc
text (forall a. Show a => a -> [Char]
show IOException
exn))

    ModuleParseError ModulePath
_source ParseError
err -> ParseError -> Doc
Parser.ppError ParseError
err

    RecursiveModules [ImportSource]
mods ->
      Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"[error] module imports form a cycle:")
         Int
4 ([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp (forall a. [a] -> [a]
reverse [ImportSource]
mods)))

    RenamerErrors ImportSource
_src [RenamerError]
errs -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp [RenamerError]
errs)

    NoPatErrors ImportSource
_src [Error]
errs -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp [Error]
errs)

    ExpandPropGuardsError ImportSource
_src Error
err -> forall a. PP a => a -> Doc
pp Error
err

    NoIncludeErrors ImportSource
_src [IncludeError]
errs -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map IncludeError -> Doc
NoInc.ppIncludeError [IncludeError]
errs)

    TypeCheckingFailed ImportSource
_src NameMap
nm [(Range, Error)]
errs -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (NameMap -> (Range, Error) -> Doc
T.ppNamedError NameMap
nm) [(Range, Error)]
errs)

    ModuleNameMismatch ModName
expected Located ModName
found ->
      Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"[error]" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> Range
P.srcRange Located ModName
found) Doc -> Doc -> Doc
<.> Char -> Doc
char Char
':')
         Int
4 ([Doc] -> Doc
vcat [ [Char] -> Doc
text [Char]
"File name does not match module name:"
                 , [Char] -> Doc
text [Char]
"  Actual:" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
P.thing Located ModName
found)
                 , [Char] -> Doc
text [Char]
"Expected:" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModName
expected
                 ])

    DuplicateModuleName ModName
name [Char]
path1 [Char]
path2 ->
      Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"[error] module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModName
name Doc -> Doc -> Doc
<+>
            [Char] -> Doc
text [Char]
"is defined in multiple files:")
         Int
4 ([Doc] -> Doc
vcat [[Char] -> Doc
text [Char]
path1, [Char] -> Doc
text [Char]
path2])

    OtherFailure [Char]
x -> [Char] -> Doc
text [Char]
x

    FFILoadErrors ModName
x [FFILoadError]
errs ->
      Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"[error] Failed to load foreign implementations for module"
            Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModName
x Doc -> Doc -> Doc
<.> Doc
colon)
         Int
4 ([Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp [FFILoadError]
errs)

    ErrorInFile ModulePath
_ ModuleError
x -> forall a. PP a => Int -> a -> Doc
ppPrec Int
prec ModuleError
x

moduleNotFound :: P.ModName -> [FilePath] -> ModuleM a
moduleNotFound :: forall a. ModName -> [[Char]] -> ModuleM a
moduleNotFound ModName
name [[Char]]
paths = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModName -> [[Char]] -> ModuleError
ModuleNotFound ModName
name [[Char]]
paths))

cantFindFile :: FilePath -> ModuleM a
cantFindFile :: forall a. [Char] -> ModuleM a
cantFindFile [Char]
path = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ([Char] -> ModuleError
CantFindFile [Char]
path))

badUtf8 :: ModulePath -> UnicodeException -> ModuleM a
badUtf8 :: forall a. ModulePath -> UnicodeException -> ModuleM a
badUtf8 ModulePath
path UnicodeException
ue = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModulePath -> UnicodeException -> ModuleError
BadUtf8 ModulePath
path UnicodeException
ue))

otherIOError :: FilePath -> IOException -> ModuleM a
otherIOError :: forall a. [Char] -> IOException -> ModuleM a
otherIOError [Char]
path IOException
exn = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ([Char] -> IOException -> ModuleError
OtherIOError [Char]
path IOException
exn))

moduleParseError :: ModulePath -> Parser.ParseError -> ModuleM a
moduleParseError :: forall a. ModulePath -> ParseError -> ModuleM a
moduleParseError ModulePath
path ParseError
err =
  forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModulePath -> ParseError -> ModuleError
ModuleParseError ModulePath
path ParseError
err))

recursiveModules :: [ImportSource] -> ModuleM a
recursiveModules :: forall a. [ImportSource] -> ModuleM a
recursiveModules [ImportSource]
loaded = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ([ImportSource] -> ModuleError
RecursiveModules [ImportSource]
loaded))

renamerErrors :: [RenamerError] -> ModuleM a
renamerErrors :: forall a. [RenamerError] -> ModuleM a
renamerErrors [RenamerError]
errs = do
  ImportSource
src <- ModuleM ImportSource
getImportSource
  forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ImportSource -> [RenamerError] -> ModuleError
RenamerErrors ImportSource
src [RenamerError]
errs))

noPatErrors :: [NoPat.Error] -> ModuleM a
noPatErrors :: forall a. [Error] -> ModuleM a
noPatErrors [Error]
errs = do
  ImportSource
src <- ModuleM ImportSource
getImportSource
  forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ImportSource -> [Error] -> ModuleError
NoPatErrors ImportSource
src [Error]
errs))

expandPropGuardsError :: ExpandPropGuards.Error -> ModuleM a
expandPropGuardsError :: forall a. Error -> ModuleM a
expandPropGuardsError Error
err = do
  ImportSource
src <- ModuleM ImportSource
getImportSource
  forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ImportSource -> Error -> ModuleError
ExpandPropGuardsError ImportSource
src Error
err))

noIncludeErrors :: [NoInc.IncludeError] -> ModuleM a
noIncludeErrors :: forall a. [IncludeError] -> ModuleM a
noIncludeErrors [IncludeError]
errs = do
  ImportSource
src <- ModuleM ImportSource
getImportSource
  forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ImportSource -> [IncludeError] -> ModuleError
NoIncludeErrors ImportSource
src [IncludeError]
errs))

typeCheckingFailed :: T.NameMap -> [(Range,T.Error)] -> ModuleM a
typeCheckingFailed :: forall a. NameMap -> [(Range, Error)] -> ModuleM a
typeCheckingFailed NameMap
nameMap [(Range, Error)]
errs = do
  ImportSource
src <- ModuleM ImportSource
getImportSource
  forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ImportSource -> NameMap -> [(Range, Error)] -> ModuleError
TypeCheckingFailed ImportSource
src NameMap
nameMap [(Range, Error)]
errs))

moduleNameMismatch :: P.ModName -> Located P.ModName -> ModuleM a
moduleNameMismatch :: forall a. ModName -> Located ModName -> ModuleM a
moduleNameMismatch ModName
expected Located ModName
found =
  forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModName -> Located ModName -> ModuleError
ModuleNameMismatch ModName
expected Located ModName
found))

duplicateModuleName :: P.ModName -> FilePath -> FilePath -> ModuleM a
duplicateModuleName :: forall a. ModName -> [Char] -> [Char] -> ModuleM a
duplicateModuleName ModName
name [Char]
path1 [Char]
path2 =
  forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModName -> [Char] -> [Char] -> ModuleError
DuplicateModuleName ModName
name [Char]
path1 [Char]
path2))

ffiLoadErrors :: P.ModName -> [FFILoadError] -> ModuleM a
ffiLoadErrors :: forall a. ModName -> [FFILoadError] -> ModuleM a
ffiLoadErrors ModName
x [FFILoadError]
errs = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModName -> [FFILoadError] -> ModuleError
FFILoadErrors ModName
x [FFILoadError]
errs))

-- | Run the computation, and if it caused and error, tag the error
-- with the given file.
errorInFile :: ModulePath -> ModuleM a -> ModuleM a
errorInFile :: forall a. ModulePath -> ModuleM a -> ModuleM a
errorInFile ModulePath
file (ModuleT ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
m) = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
m forall (m :: * -> *) x a.
RunExceptionM m x =>
m a -> (x -> m a) -> m a
`handle` forall {m :: * -> *} {a}.
ExceptionM m ModuleError =>
ModuleError -> m a
h)
  where h :: ModuleError -> m a
h ModuleError
e = forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise forall a b. (a -> b) -> a -> b
$ case ModuleError
e of
                        ErrorInFile {} -> ModuleError
e
                        ModuleError
_              -> ModulePath -> ModuleError -> ModuleError
ErrorInFile ModulePath
file ModuleError
e

-- Warnings --------------------------------------------------------------------

data ModuleWarning
  = TypeCheckWarnings T.NameMap [(Range,T.Warning)]
  | RenamerWarnings [RenamerWarning]
    deriving (Int -> ModuleWarning -> ShowS
[ModuleWarning] -> ShowS
ModuleWarning -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ModuleWarning] -> ShowS
$cshowList :: [ModuleWarning] -> ShowS
show :: ModuleWarning -> [Char]
$cshow :: ModuleWarning -> [Char]
showsPrec :: Int -> ModuleWarning -> ShowS
$cshowsPrec :: Int -> ModuleWarning -> ShowS
Show, forall x. Rep ModuleWarning x -> ModuleWarning
forall x. ModuleWarning -> Rep ModuleWarning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModuleWarning x -> ModuleWarning
$cfrom :: forall x. ModuleWarning -> Rep ModuleWarning x
Generic, ModuleWarning -> ()
forall a. (a -> ()) -> NFData a
rnf :: ModuleWarning -> ()
$crnf :: ModuleWarning -> ()
NFData)

instance PP ModuleWarning where
  ppPrec :: Int -> ModuleWarning -> Doc
ppPrec Int
_ ModuleWarning
w = case ModuleWarning
w of
    TypeCheckWarnings NameMap
nm [(Range, Warning)]
ws -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (NameMap -> (Range, Warning) -> Doc
T.ppNamedWarning NameMap
nm) [(Range, Warning)]
ws)
    RenamerWarnings [RenamerWarning]
ws   -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp [RenamerWarning]
ws)

warn :: [ModuleWarning] -> ModuleM ()
warn :: [ModuleWarning] -> ModuleM ()
warn  = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) i. WriterM m i => i -> m ()
put

typeCheckWarnings :: T.NameMap -> [(Range,T.Warning)] -> ModuleM ()
typeCheckWarnings :: NameMap -> [(Range, Warning)] -> ModuleM ()
typeCheckWarnings NameMap
nameMap [(Range, Warning)]
ws
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Range, Warning)]
ws   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = [ModuleWarning] -> ModuleM ()
warn [NameMap -> [(Range, Warning)] -> ModuleWarning
TypeCheckWarnings NameMap
nameMap [(Range, Warning)]
ws]

renamerWarnings :: [RenamerWarning] -> ModuleM ()
renamerWarnings :: [RenamerWarning] -> ModuleM ()
renamerWarnings [RenamerWarning]
ws
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RenamerWarning]
ws   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = [ModuleWarning] -> ModuleM ()
warn [[RenamerWarning] -> ModuleWarning
RenamerWarnings [RenamerWarning]
ws]


-- Module System Monad ---------------------------------------------------------

data RO m =
  RO { forall (m :: * -> *). RO m -> [ImportSource]
roLoading    :: [ImportSource]
     , forall (m :: * -> *). RO m -> m EvalOpts
roEvalOpts   :: m EvalOpts
     , forall (m :: * -> *). RO m -> Bool
roCallStacks :: Bool
     , forall (m :: * -> *). RO m -> [Char] -> m ByteString
roFileReader :: FilePath -> m ByteString
     , forall (m :: * -> *). RO m -> Solver
roTCSolver   :: SMT.Solver
     }

emptyRO :: ModuleInput m -> RO m
emptyRO :: forall (m :: * -> *). ModuleInput m -> RO m
emptyRO ModuleInput m
minp =
  RO { roLoading :: [ImportSource]
roLoading = []
     , roEvalOpts :: m EvalOpts
roEvalOpts   = forall (m :: * -> *). ModuleInput m -> m EvalOpts
minpEvalOpts ModuleInput m
minp
     , roCallStacks :: Bool
roCallStacks = forall (m :: * -> *). ModuleInput m -> Bool
minpCallStacks ModuleInput m
minp
     , roFileReader :: [Char] -> m ByteString
roFileReader = forall (m :: * -> *). ModuleInput m -> [Char] -> m ByteString
minpByteReader ModuleInput m
minp
     , roTCSolver :: Solver
roTCSolver   = forall (m :: * -> *). ModuleInput m -> Solver
minpTCSolver ModuleInput m
minp
     }

newtype ModuleT m a = ModuleT
  { forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT :: ReaderT (RO m)
                   (StateT ModuleEnv
                     (ExceptionT ModuleError
                       (WriterT [ModuleWarning] m))) a
  }

instance Monad m => Functor (ModuleT m) where
  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> ModuleT m a -> ModuleT m b
fmap a -> b
f ModuleT m a
m      = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT ModuleT m a
m))

instance Monad m => Applicative (ModuleT m) where
  {-# INLINE pure #-}
  pure :: forall a. a -> ModuleT m a
pure a
x = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)

  {-# INLINE (<*>) #-}
  ModuleT m (a -> b)
l <*> :: forall a b. ModuleT m (a -> b) -> ModuleT m a -> ModuleT m b
<*> ModuleT m a
r = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT ModuleT m (a -> b)
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT ModuleT m a
r)

instance Monad m => Monad (ModuleT m) where
  {-# INLINE return #-}
  return :: forall a. a -> ModuleT m a
return        = forall (f :: * -> *) a. Applicative f => a -> f a
pure

  {-# INLINE (>>=) #-}
  ModuleT m a
m >>= :: forall a b. ModuleT m a -> (a -> ModuleT m b) -> ModuleT m b
>>= a -> ModuleT m b
f       = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT ModuleT m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ModuleT m b
f)

instance Fail.MonadFail m => Fail.MonadFail (ModuleT m) where
  {-# INLINE fail #-}
  fail :: forall a. [Char] -> ModuleT m a
fail          = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ModuleError
OtherFailure

instance MonadT ModuleT where
  {-# INLINE lift #-}
  lift :: forall (m :: * -> *) a. Monad m => m a -> ModuleT m a
lift = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift

instance Monad m => FreshM (ModuleT m) where
  liftSupply :: forall a. (Supply -> (a, Supply)) -> ModuleT m a
liftSupply Supply -> (a, Supply)
f = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$
    do ModuleEnv
me <- forall (m :: * -> *) i. StateM m i => m i
get
       let (a
a,Supply
s') = Supply -> (a, Supply)
f (ModuleEnv -> Supply
meSupply ModuleEnv
me)
       forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
me { meSupply :: Supply
meSupply = Supply
s' }
       forall (m :: * -> *) a. Monad m => a -> m a
return a
a

instance MonadIO m => MonadIO (ModuleT m) where
  liftIO :: forall a. IO a -> ModuleT m a
liftIO IO a
m = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m


data ModuleInput m =
  ModuleInput
  { forall (m :: * -> *). ModuleInput m -> Bool
minpCallStacks :: Bool
  , forall (m :: * -> *). ModuleInput m -> m EvalOpts
minpEvalOpts   :: m EvalOpts
  , forall (m :: * -> *). ModuleInput m -> [Char] -> m ByteString
minpByteReader :: FilePath -> m ByteString
  , forall (m :: * -> *). ModuleInput m -> ModuleEnv
minpModuleEnv  :: ModuleEnv
  , forall (m :: * -> *). ModuleInput m -> Solver
minpTCSolver   :: SMT.Solver
  }

runModuleT ::
  Monad m =>
  ModuleInput m ->
  ModuleT m a ->
  m (Either ModuleError (a, ModuleEnv), [ModuleWarning])
runModuleT :: forall (m :: * -> *) a.
Monad m =>
ModuleInput m
-> ModuleT m a
-> m (Either ModuleError (a, ModuleEnv), [ModuleWarning])
runModuleT ModuleInput m
minp ModuleT m a
m =
    forall (m :: * -> *) i a. Monad m => WriterT i m a -> m (a, i)
runWriterT
  forall a b. (a -> b) -> a -> b
$ forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT
  forall a b. (a -> b) -> a -> b
$ forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT (forall (m :: * -> *). ModuleInput m -> ModuleEnv
minpModuleEnv ModuleInput m
minp)
  forall a b. (a -> b) -> a -> b
$ forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT (forall (m :: * -> *). ModuleInput m -> RO m
emptyRO ModuleInput m
minp)
  forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT ModuleT m a
m

type ModuleM = ModuleT IO

runModuleM ::
  ModuleInput IO ->
  ModuleM a ->
  IO (Either ModuleError (a,ModuleEnv),[ModuleWarning])
runModuleM :: forall a.
ModuleInput IO
-> ModuleM a
-> IO (Either ModuleError (a, ModuleEnv), [ModuleWarning])
runModuleM = forall (m :: * -> *) a.
Monad m =>
ModuleInput m
-> ModuleT m a
-> m (Either ModuleError (a, ModuleEnv), [ModuleWarning])
runModuleT


io :: BaseM m IO => IO a -> ModuleT m a
io :: forall (m :: * -> *) a. BaseM m IO => IO a -> ModuleT m a
io IO a
m = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *) (n :: * -> *) a. BaseM m n => n a -> m a
inBase IO a
m)

getByteReader :: Monad m => ModuleT m (FilePath -> m ByteString)
getByteReader :: forall (m :: * -> *). Monad m => ModuleT m ([Char] -> m ByteString)
getByteReader = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  RO { roFileReader :: forall (m :: * -> *). RO m -> [Char] -> m ByteString
roFileReader = [Char] -> m ByteString
readFileBytes } <- forall (m :: * -> *) i. ReaderM m i => m i
ask
  forall (m :: * -> *) a. Monad m => a -> m a
return [Char] -> m ByteString
readFileBytes

getCallStacks :: Monad m => ModuleT m Bool
getCallStacks :: forall (m :: * -> *). Monad m => ModuleT m Bool
getCallStacks = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *). RO m -> Bool
roCallStacks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. ReaderM m i => m i
ask)

readBytes :: Monad m => FilePath -> ModuleT m ByteString
readBytes :: forall (m :: * -> *). Monad m => [Char] -> ModuleT m ByteString
readBytes [Char]
fn = do
  [Char] -> m ByteString
fileReader <- forall (m :: * -> *). Monad m => ModuleT m ([Char] -> m ByteString)
getByteReader
  forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ [Char] -> m ByteString
fileReader [Char]
fn

getModuleEnv :: Monad m => ModuleT m ModuleEnv
getModuleEnv :: forall (m :: * -> *). Monad m => ModuleT m ModuleEnv
getModuleEnv = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall (m :: * -> *) i. StateM m i => m i
get

getTCSolver :: Monad m => ModuleT m SMT.Solver
getTCSolver :: forall (m :: * -> *). Monad m => ModuleT m Solver
getTCSolver = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *). RO m -> Solver
roTCSolver forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. ReaderM m i => m i
ask)

setModuleEnv :: Monad m => ModuleEnv -> ModuleT m ()
setModuleEnv :: forall (m :: * -> *). Monad m => ModuleEnv -> ModuleT m ()
setModuleEnv = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) i. StateM m i => i -> m ()
set

modifyModuleEnv :: Monad m => (ModuleEnv -> ModuleEnv) -> ModuleT m ()
modifyModuleEnv :: forall (m :: * -> *).
Monad m =>
(ModuleEnv -> ModuleEnv) -> ModuleT m ()
modifyModuleEnv ModuleEnv -> ModuleEnv
f = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
  forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv -> ModuleEnv
f ModuleEnv
env

getLoadedMaybe :: P.ModName -> ModuleM (Maybe (LoadedModuleG T.TCTopEntity))
getLoadedMaybe :: ModName -> ModuleM (Maybe (LoadedModuleG TCTopEntity))
getLoadedMaybe ModName
mn = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$
  do ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
     forall (m :: * -> *) a. Monad m => a -> m a
return (ModName -> ModuleEnv -> Maybe (LoadedModuleG TCTopEntity)
lookupTCEntity ModName
mn ModuleEnv
env)

-- | This checks if the given name is loaded---it might refer to either
-- a module or a signature.
isLoaded :: P.ModName -> ModuleM Bool
isLoaded :: ModName -> ModuleM Bool
isLoaded ModName
mn =
  do ModuleEnv
env <- forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall (m :: * -> *) i. StateM m i => m i
get
     forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModName -> LoadedModules -> Bool
MEnv.isLoaded ModName
mn (ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
env))

loadingImport :: Located P.Import -> ModuleM a -> ModuleM a
loadingImport :: forall a. Located Import -> ModuleM a -> ModuleM a
loadingImport  = forall a. ImportSource -> ModuleM a -> ModuleM a
loading forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Import -> ImportSource
FromImport

loadingModule :: P.ModName -> ModuleM a -> ModuleM a
loadingModule :: forall a. ModName -> ModuleM a -> ModuleM a
loadingModule  = forall a. ImportSource -> ModuleM a -> ModuleM a
loading forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModName -> ImportSource
FromModule

loadingModInstance :: Located P.ModName -> ModuleM a -> ModuleM a
loadingModInstance :: forall a. Located ModName -> ModuleM a -> ModuleM a
loadingModInstance = forall a. ImportSource -> ModuleM a -> ModuleM a
loading forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModName -> ImportSource
FromModuleInstance

-- | Push an "interactive" context onto the loading stack.  A bit of a hack, as
-- it uses a faked module name
interactive :: ModuleM a -> ModuleM a
interactive :: forall a. ModuleM a -> ModuleM a
interactive  = forall a. ModName -> ModuleM a -> ModuleM a
loadingModule ModName
interactiveName

loading :: ImportSource -> ModuleM a -> ModuleM a
loading :: forall a. ImportSource -> ModuleM a -> ModuleM a
loading ImportSource
src ModuleM a
m = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  RO IO
ro <- forall (m :: * -> *) i. ReaderM m i => m i
ask
  let new :: [ImportSource]
new = ImportSource
src forall a. a -> [a] -> [a]
: forall (m :: * -> *). RO m -> [ImportSource]
roLoading RO IO
ro

  -- check for recursive modules
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ImportSource
src forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall (m :: * -> *). RO m -> [ImportSource]
roLoading RO IO
ro) (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ([ImportSource] -> ModuleError
RecursiveModules [ImportSource]
new))

  forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local RO IO
ro { roLoading :: [ImportSource]
roLoading = [ImportSource]
new } (forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT ModuleM a
m)

-- | Get the currently focused import source.
getImportSource :: ModuleM ImportSource
getImportSource :: ModuleM ImportSource
getImportSource  = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  RO IO
ro <- forall (m :: * -> *) i. ReaderM m i => m i
ask
  case forall (m :: * -> *). RO m -> [ImportSource]
roLoading RO IO
ro of
    ImportSource
is : [ImportSource]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ImportSource
is
    [ImportSource]
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return (ModName -> ImportSource
FromModule ModName
noModuleName)

getIfaces :: ModuleM (Map P.ModName (Either T.ModParamNames Iface))
getIfaces :: ModuleM (Map ModName (Either ModParamNames Iface))
getIfaces = ModuleEnv -> Map ModName (Either ModParamNames Iface)
toMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall (m :: * -> *) i. StateM m i => m i
get
  where
  toMap :: ModuleEnv -> Map ModName (Either ModParamNames Iface)
toMap ModuleEnv
env = LoadedEntity -> Either ModParamNames Iface
cvt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadedModules -> Map ModName LoadedEntity
getLoadedEntities (ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
env)

  cvt :: LoadedEntity -> Either ModParamNames Iface
cvt LoadedEntity
ent =
    case LoadedEntity
ent of
      ALoadedInterface LoadedSignature
ifa -> forall a b. a -> Either a b
Left (forall a. LoadedModuleG a -> a
lmData LoadedSignature
ifa)
      ALoadedFunctor LoadedModule
mo -> forall a b. b -> Either a b
Right (LoadedModuleData -> Iface
lmdInterface (forall a. LoadedModuleG a -> a
lmData LoadedModule
mo))
      ALoadedModule LoadedModule
mo -> forall a b. b -> Either a b
Right (LoadedModuleData -> Iface
lmdInterface (forall a. LoadedModuleG a -> a
lmData LoadedModule
mo))

getLoaded :: P.ModName -> ModuleM T.Module
getLoaded :: ModName -> ModuleM Module
getLoaded ModName
mn = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$
  do ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
     case ModName -> ModuleEnv -> Maybe LoadedModule
lookupModule ModName
mn ModuleEnv
env of
       Just LoadedModule
lm -> forall (m :: * -> *) a. Monad m => a -> m a
return (LoadedModule -> Module
lmModule LoadedModule
lm)
       Maybe LoadedModule
Nothing -> forall a. HasCallStack => [Char] -> [[Char]] -> a
panic [Char]
"ModuleSystem" [[Char]
"Module not available", forall a. Show a => a -> [Char]
show (forall a. PP a => a -> Doc
pp ModName
mn) ]

getAllLoaded :: ModuleM (P.ModName -> Maybe (T.ModuleG (), IfaceG ()))
getAllLoaded :: ModuleM (ModName -> Maybe (ModuleG (), IfaceG ()))
getAllLoaded = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT
  do ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
     forall (f :: * -> *) a. Applicative f => a -> f a
pure \ModName
nm -> do LoadedModule
lm <- ModName -> ModuleEnv -> Maybe LoadedModule
lookupModule ModName
nm ModuleEnv
env
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure ( (LoadedModule -> Module
lmModule LoadedModule
lm) { mName :: ()
T.mName = () }
                         , forall name. IfaceG name -> IfaceG ()
ifaceForgetName (LoadedModule -> Iface
lmInterface LoadedModule
lm)
                         )

getAllLoadedSignatures :: ModuleM (P.ModName -> Maybe T.ModParamNames)
getAllLoadedSignatures :: ModuleM (ModName -> Maybe ModParamNames)
getAllLoadedSignatures = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT
  do ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
     forall (f :: * -> *) a. Applicative f => a -> f a
pure \ModName
nm -> forall a. LoadedModuleG a -> a
lmData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModName -> ModuleEnv -> Maybe LoadedSignature
lookupSignature ModName
nm ModuleEnv
env


getNameSeeds :: ModuleM T.NameSeeds
getNameSeeds :: ModuleM NameSeeds
getNameSeeds  = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> NameSeeds
meNameSeeds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)

getSupply :: ModuleM Supply
getSupply :: ModuleM Supply
getSupply  = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> Supply
meSupply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)

getMonoBinds :: ModuleM Bool
getMonoBinds :: ModuleM Bool
getMonoBinds  = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> Bool
meMonoBinds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)

setMonoBinds :: Bool -> ModuleM ()
setMonoBinds :: Bool -> ModuleM ()
setMonoBinds Bool
b = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
  forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meMonoBinds :: Bool
meMonoBinds = Bool
b }

setNameSeeds :: T.NameSeeds -> ModuleM ()
setNameSeeds :: NameSeeds -> ModuleM ()
setNameSeeds NameSeeds
seeds = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
  forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meNameSeeds :: NameSeeds
meNameSeeds = NameSeeds
seeds }

setSupply :: Supply -> ModuleM ()
setSupply :: Supply -> ModuleM ()
setSupply Supply
supply = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$
  do ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
     forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meSupply :: Supply
meSupply = Supply
supply }

unloadModule :: (forall a. LoadedModuleG a -> Bool) -> ModuleM ()
unloadModule :: (forall a. LoadedModuleG a -> Bool) -> ModuleM ()
unloadModule forall a. LoadedModuleG a -> Bool
rm = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
  forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meLoadedModules :: LoadedModules
meLoadedModules = (forall a. LoadedModuleG a -> Bool)
-> LoadedModules -> LoadedModules
removeLoadedModule forall a. LoadedModuleG a -> Bool
rm (ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
env) }

loadedModule ::
  ModulePath ->
  FileInfo ->
  NamingEnv ->
  Maybe ForeignSrc ->
  T.TCTopEntity ->
  ModuleM ()
loadedModule :: ModulePath
-> FileInfo
-> NamingEnv
-> Maybe ForeignSrc
-> TCTopEntity
-> ModuleM ()
loadedModule ModulePath
path FileInfo
fi NamingEnv
nameEnv Maybe ForeignSrc
fsrc TCTopEntity
m = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
  [Char]
ident <- case ModulePath
path of
             InFile [Char]
p  -> forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. BaseM m IO => IO a -> ModuleT m a
io ([Char] -> IO [Char]
canonicalizePath [Char]
p)
             InMem [Char]
l ByteString
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
l

  let newLM :: LoadedModules -> LoadedModules
newLM =
        case TCTopEntity
m of
          T.TCTopModule Module
mo -> ModulePath
-> [Char]
-> FileInfo
-> NamingEnv
-> Maybe ForeignSrc
-> Module
-> LoadedModules
-> LoadedModules
addLoadedModule ModulePath
path [Char]
ident FileInfo
fi NamingEnv
nameEnv Maybe ForeignSrc
fsrc Module
mo
          T.TCTopSignature ModName
x ModParamNames
s -> ModulePath
-> [Char]
-> FileInfo
-> NamingEnv
-> ModName
-> ModParamNames
-> LoadedModules
-> LoadedModules
addLoadedSignature ModulePath
path [Char]
ident FileInfo
fi NamingEnv
nameEnv ModName
x ModParamNames
s

  forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meLoadedModules :: LoadedModules
meLoadedModules = LoadedModules -> LoadedModules
newLM (ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
env) }


modifyEvalEnvM :: Traversable t =>
  (EvalEnv -> E.Eval (t EvalEnv)) -> ModuleM (t ())
modifyEvalEnvM :: forall (t :: * -> *).
Traversable t =>
(EvalEnv -> Eval (t EvalEnv)) -> ModuleM (t ())
modifyEvalEnvM EvalEnv -> Eval (t EvalEnv)
f = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
  let evalEnv :: EvalEnv
evalEnv = ModuleEnv -> EvalEnv
meEvalEnv ModuleEnv
env
  t EvalEnv
tenv <- forall (m :: * -> *) (n :: * -> *) a. BaseM m n => n a -> m a
inBase (forall a. CallStack -> Eval a -> IO a
E.runEval forall a. Monoid a => a
mempty (EvalEnv -> Eval (t EvalEnv)
f EvalEnv
evalEnv))
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\EvalEnv
evalEnv' -> forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meEvalEnv :: EvalEnv
meEvalEnv = EvalEnv
evalEnv' }) t EvalEnv
tenv

modifyEvalEnv :: (EvalEnv -> E.Eval EvalEnv) -> ModuleM ()
modifyEvalEnv :: (EvalEnv -> Eval EvalEnv) -> ModuleM ()
modifyEvalEnv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
Traversable t =>
(EvalEnv -> Eval (t EvalEnv)) -> ModuleM (t ())
modifyEvalEnvM forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

getEvalEnv :: ModuleM EvalEnv
getEvalEnv :: ModuleM EvalEnv
getEvalEnv  = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> EvalEnv
meEvalEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)

getEvalOptsAction :: ModuleM (IO EvalOpts)
getEvalOptsAction :: ModuleM (IO EvalOpts)
getEvalOptsAction = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (forall (m :: * -> *). RO m -> m EvalOpts
roEvalOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. ReaderM m i => m i
ask)

getEvalOpts :: ModuleM EvalOpts
getEvalOpts :: ModuleM EvalOpts
getEvalOpts =
  do IO EvalOpts
act <- ModuleM (IO EvalOpts)
getEvalOptsAction
     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO EvalOpts
act

getNewtypes :: ModuleM (Map T.Name T.Newtype)
getNewtypes :: ModuleM (Map Name Newtype)
getNewtypes = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> Map Name Newtype
loadedNewtypes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. StateM m i => m i
get)

getFocusedModule :: ModuleM (Maybe P.ModName)
getFocusedModule :: ModuleM (Maybe ModName)
getFocusedModule  = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> Maybe ModName
meFocusedModule forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)

setFocusedModule :: P.ModName -> ModuleM ()
setFocusedModule :: ModName -> ModuleM ()
setFocusedModule ModName
n = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
me <- forall (m :: * -> *) i. StateM m i => m i
get
  forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
me { meFocusedModule :: Maybe ModName
meFocusedModule = forall a. a -> Maybe a
Just ModName
n }

getSearchPath :: ModuleM [FilePath]
getSearchPath :: ModuleM [[Char]]
getSearchPath  = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> [[Char]]
meSearchPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)

-- | Run a 'ModuleM' action in a context with a prepended search
-- path. Useful for temporarily looking in other places while
-- resolving imports, for example.
withPrependedSearchPath :: [FilePath] -> ModuleM a -> ModuleM a
withPrependedSearchPath :: forall a. [[Char]] -> ModuleM a -> ModuleM a
withPrependedSearchPath [[Char]]
fps ModuleM a
m = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env0 <- forall (m :: * -> *) i. StateM m i => m i
get
  let fps0 :: [[Char]]
fps0 = ModuleEnv -> [[Char]]
meSearchPath ModuleEnv
env0
  forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env0 { meSearchPath :: [[Char]]
meSearchPath = [[Char]]
fps forall a. [a] -> [a] -> [a]
++ [[Char]]
fps0 }
  a
x <- forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT ModuleM a
m
  ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
  forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meSearchPath :: [[Char]]
meSearchPath = [[Char]]
fps0 }
  forall (m :: * -> *) a. Monad m => a -> m a
return a
x

getFocusedEnv :: ModuleM ModContext
getFocusedEnv :: ModuleM ModContext
getFocusedEnv  = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> ModContext
focusedEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)

getDynEnv :: ModuleM DynamicEnv
getDynEnv :: ModuleM DynamicEnv
getDynEnv  = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> DynamicEnv
meDynEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)

setDynEnv :: DynamicEnv -> ModuleM ()
setDynEnv :: DynamicEnv -> ModuleM ()
setDynEnv DynamicEnv
denv = forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
me <- forall (m :: * -> *) i. StateM m i => m i
get
  forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
me { meDynEnv :: DynamicEnv
meDynEnv = DynamicEnv
denv }

-- | Usefule for logging.  For example: @withLogger logPutStrLn "Hello"@
withLogger :: (Logger -> a -> IO b) -> a -> ModuleM b
withLogger :: forall a b. (Logger -> a -> IO b) -> a -> ModuleM b
withLogger Logger -> a -> IO b
f a
a = do EvalOpts
l <- ModuleM EvalOpts
getEvalOpts
                    forall (m :: * -> *) a. BaseM m IO => IO a -> ModuleT m a
io (Logger -> a -> IO b
f (EvalOpts -> Logger
evalLogger EvalOpts
l) a
a)