-- |
-- 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 -> String
(Int -> ImportSource -> ShowS)
-> (ImportSource -> String)
-> ([ImportSource] -> ShowS)
-> Show ImportSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportSource -> ShowS
showsPrec :: Int -> ImportSource -> ShowS
$cshow :: ImportSource -> String
show :: ImportSource -> String
$cshowList :: [ImportSource] -> ShowS
showList :: [ImportSource] -> ShowS
Show, (forall x. ImportSource -> Rep ImportSource x)
-> (forall x. Rep ImportSource x -> ImportSource)
-> Generic ImportSource
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
$cfrom :: forall x. ImportSource -> Rep ImportSource x
from :: forall x. ImportSource -> Rep ImportSource x
$cto :: forall x. Rep ImportSource x -> ImportSource
to :: forall x. Rep ImportSource x -> ImportSource
Generic, ImportSource -> ()
(ImportSource -> ()) -> NFData ImportSource
forall a. (a -> ()) -> NFData a
$crnf :: ImportSource -> ()
rnf :: ImportSource -> ()
NFData)

instance Eq ImportSource where
  == :: ImportSource -> ImportSource -> Bool
(==) = ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ModName -> ModName -> Bool)
-> (ImportSource -> ModName)
-> ImportSource
-> ImportSource
-> 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  -> String -> Doc
text String
"module name" Doc -> Doc -> Doc
<+> ModName -> Doc
forall a. PP a => a -> Doc
pp ModName
n
    FromImport Located Import
li -> String -> Doc
text String
"import of module" Doc -> Doc -> Doc
<+> ModName -> Doc
forall a. PP a => a -> Doc
pp (Import -> ModName
forall mname. ImportG mname -> mname
P.iModule (Located Import -> Import
forall a. Located a -> a
P.thing Located Import
li))
    FromSigImport Located ModName
l -> String -> Doc
text String
"import of interface" Doc -> Doc -> Doc
<+> ModName -> Doc
forall a. PP a => a -> Doc
pp (Located ModName -> ModName
forall a. Located a -> a
P.thing Located ModName
l)
    FromModuleInstance Located ModName
l ->
      String -> Doc
text String
"instantiation of module" Doc -> Doc -> Doc
<+> ModName -> Doc
forall a. PP a => a -> Doc
pp (Located ModName -> ModName
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         -> Import -> ModName
forall mname. ImportG mname -> mname
P.iModule (Located Import -> Import
forall a. Located a -> a
P.thing Located Import
li)
    FromModuleInstance Located ModName
l  -> Located ModName -> ModName
forall a. Located a -> a
P.thing Located ModName
l
    FromSigImport Located ModName
l       -> Located ModName -> ModName
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 -> String
(Int -> ModuleError -> ShowS)
-> (ModuleError -> String)
-> ([ModuleError] -> ShowS)
-> Show ModuleError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleError -> ShowS
showsPrec :: Int -> ModuleError -> ShowS
$cshow :: ModuleError -> String
show :: ModuleError -> String
$cshowList :: [ModuleError] -> ShowS
showList :: [ModuleError] -> ShowS
Show)

instance NFData ModuleError where
  rnf :: ModuleError -> ()
rnf ModuleError
e = case ModuleError
e of
    ModuleNotFound ModName
src [String]
path              -> ModName
src ModName -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` [String]
path [String] -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    CantFindFile String
path                    -> String
path String -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    BadUtf8 ModulePath
path UnicodeException
ue                      -> (ModulePath, UnicodeException) -> ()
forall a. NFData a => a -> ()
rnf (ModulePath
path, UnicodeException
ue)
    OtherIOError String
path IOException
exn                -> String
path String -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` IOException
exn IOException -> () -> ()
forall a b. a -> b -> b
`seq` ()
    ModuleParseError ModulePath
source ParseError
err          -> ModulePath
source ModulePath -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ParseError
err ParseError -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    RecursiveModules [ImportSource]
mods                -> [ImportSource]
mods [ImportSource] -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    RenamerErrors ImportSource
src [RenamerError]
errs               -> ImportSource
src ImportSource -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` [RenamerError]
errs [RenamerError] -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    NoPatErrors ImportSource
src [Error]
errs                 -> ImportSource
src ImportSource -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` [Error]
errs [Error] -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    ExpandPropGuardsError ImportSource
src Error
err        -> ImportSource
src ImportSource -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Error
err Error -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    NoIncludeErrors ImportSource
src [IncludeError]
errs             -> ImportSource
src ImportSource -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` [IncludeError]
errs [IncludeError] -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    TypeCheckingFailed ImportSource
nm NameMap
src [(Range, Error)]
errs       -> ImportSource
nm ImportSource -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` NameMap
src NameMap -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` [(Range, Error)]
errs [(Range, Error)] -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    ModuleNameMismatch ModName
expected Located ModName
found    ->
      ModName
expected ModName -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Located ModName
found Located ModName -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    DuplicateModuleName ModName
name String
path1 String
path2 ->
      ModName
name ModName -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` String
path1 String -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` String
path2 String -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    OtherFailure String
x                       -> String
x String -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    FFILoadErrors ModName
x [FFILoadError]
errs                 -> ModName
x ModName -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` [FFILoadError]
errs [FFILoadError] -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
    ErrorInFile ModulePath
x ModuleError
y                      -> ModulePath
x ModulePath -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ModuleError
y ModuleError -> () -> ()
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 [String]
path ->
      String -> Doc
text String
"[error]" Doc -> Doc -> Doc
<+>
      String -> Doc
text String
"Could not find module" Doc -> Doc -> Doc
<+> ModName -> Doc
forall a. PP a => a -> Doc
pp ModName
src
      Doc -> Doc -> Doc
$$
      Doc -> Int -> Doc -> Doc
hang (String -> Doc
text String
"Searched paths:")
         Int
4 ([Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String]
path))
      Doc -> Doc -> Doc
$$
      String -> Doc
text String
"Set the CRYPTOLPATH environment variable to search more directories"

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

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

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

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

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

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

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

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

    NoIncludeErrors ImportSource
_src [IncludeError]
errs -> [Doc] -> Doc
vcat ((IncludeError -> Doc) -> [IncludeError] -> [Doc]
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 (((Range, Error) -> Doc) -> [(Range, Error)] -> [Doc]
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 (String -> Doc
text String
"[error]" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located ModName -> Range
forall a. Located a -> Range
P.srcRange Located ModName
found) Doc -> Doc -> Doc
<.> Char -> Doc
char Char
':')
         Int
4 ([Doc] -> Doc
vcat [ String -> Doc
text String
"File name does not match module name:"
                 , String -> Doc
text String
"  Actual:" Doc -> Doc -> Doc
<+> ModName -> Doc
forall a. PP a => a -> Doc
pp (Located ModName -> ModName
forall a. Located a -> a
P.thing Located ModName
found)
                 , String -> Doc
text String
"Expected:" Doc -> Doc -> Doc
<+> ModName -> Doc
forall a. PP a => a -> Doc
pp ModName
expected
                 ])

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

    OtherFailure String
x -> String -> Doc
text String
x

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

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

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

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

badUtf8 :: ModulePath -> UnicodeException -> ModuleM a
badUtf8 :: forall a. ModulePath -> UnicodeException -> ModuleM a
badUtf8 ModulePath
path UnicodeException
ue = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleT IO a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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. String -> IOException -> ModuleM a
otherIOError String
path IOException
exn = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleT IO a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (String -> IOException -> ModuleError
OtherIOError String
path IOException
exn))

moduleParseError :: ModulePath -> Parser.ParseError -> ModuleM a
moduleParseError :: forall a. ModulePath -> ParseError -> ModuleM a
moduleParseError ModulePath
path ParseError
err =
  ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleT IO a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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 = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleT IO a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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
  ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleM a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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
  ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleM a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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
  ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleM a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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
  ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleM a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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
  ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleM a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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 =
  ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleT IO a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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 -> String -> String -> ModuleM a
duplicateModuleName ModName
name String
path1 String
path2 =
  ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleT IO a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModName -> String -> String -> ModuleError
DuplicateModuleName ModName
name String
path1 String
path2))

ffiLoadErrors :: P.ModName -> [FFILoadError] -> ModuleM a
ffiLoadErrors :: forall a. ModName -> [FFILoadError] -> ModuleM a
ffiLoadErrors ModName
x [FFILoadError]
errs = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleT IO a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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) = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleT IO a
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 ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> (ModuleError
    -> ReaderT
         (RO IO)
         (StateT
            ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
         a)
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall (m :: * -> *) x a.
RunExceptionM m x =>
m a -> (x -> m a) -> m a
`handle` ModuleError
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall {m :: * -> *} {a}.
ExceptionM m ModuleError =>
ModuleError -> m a
h)
  where h :: ModuleError -> m a
h ModuleError
e = ModuleError -> m a
forall a. ModuleError -> m a
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModuleError -> m a) -> ModuleError -> m a
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 -> String
(Int -> ModuleWarning -> ShowS)
-> (ModuleWarning -> String)
-> ([ModuleWarning] -> ShowS)
-> Show ModuleWarning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleWarning -> ShowS
showsPrec :: Int -> ModuleWarning -> ShowS
$cshow :: ModuleWarning -> String
show :: ModuleWarning -> String
$cshowList :: [ModuleWarning] -> ShowS
showList :: [ModuleWarning] -> ShowS
Show, (forall x. ModuleWarning -> Rep ModuleWarning x)
-> (forall x. Rep ModuleWarning x -> ModuleWarning)
-> Generic ModuleWarning
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
$cfrom :: forall x. ModuleWarning -> Rep ModuleWarning x
from :: forall x. ModuleWarning -> Rep ModuleWarning x
$cto :: forall x. Rep ModuleWarning x -> ModuleWarning
to :: forall x. Rep ModuleWarning x -> ModuleWarning
Generic, ModuleWarning -> ()
(ModuleWarning -> ()) -> NFData ModuleWarning
forall a. (a -> ()) -> NFData a
$crnf :: ModuleWarning -> ()
rnf :: 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 (((Range, Warning) -> Doc) -> [(Range, Warning)] -> [Doc]
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 ((RenamerWarning -> Doc) -> [RenamerWarning] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RenamerWarning -> Doc
forall a. PP a => a -> Doc
pp [RenamerWarning]
ws)

warn :: [ModuleWarning] -> ModuleM ()
warn :: [ModuleWarning] -> ModuleM ()
warn  = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ()
-> ModuleM ()
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)))
   ()
 -> ModuleM ())
-> ([ModuleWarning]
    -> ReaderT
         (RO IO)
         (StateT
            ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
         ())
-> [ModuleWarning]
-> ModuleM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleWarning]
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
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
  | [(Range, Warning)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Range, Warning)]
ws   = () -> ModuleM ()
forall a. a -> ModuleT IO a
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
  | [RenamerWarning] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RenamerWarning]
ws   = () -> ModuleM ()
forall a. a -> ModuleT IO a
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 -> String -> 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   = ModuleInput m -> m EvalOpts
forall (m :: * -> *). ModuleInput m -> m EvalOpts
minpEvalOpts ModuleInput m
minp
     , roCallStacks :: Bool
roCallStacks = ModuleInput m -> Bool
forall (m :: * -> *). ModuleInput m -> Bool
minpCallStacks ModuleInput m
minp
     , roFileReader :: String -> m ByteString
roFileReader = ModuleInput m -> String -> m ByteString
forall (m :: * -> *). ModuleInput m -> String -> m ByteString
minpByteReader ModuleInput m
minp
     , roTCSolver :: Solver
roTCSolver   = ModuleInput m -> Solver
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      = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  b
-> ModuleT m b
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT ((a -> b)
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     b
forall a b.
(a -> b)
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
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 = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
forall a.
a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
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 = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  b
-> ModuleT m b
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleT m (a -> b)
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     (a -> b)
forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT ModuleT m (a -> b)
l ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  (a -> b)
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     b
forall a b.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  (a -> b)
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
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        = a -> ModuleT m a
forall a. a -> ModuleT m a
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       = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  b
-> ModuleT m b
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT ModuleT m a
m ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> (a
    -> ReaderT
         (RO m)
         (StateT
            ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
         b)
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     b
forall a b.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> (a
    -> ReaderT
         (RO m)
         (StateT
            ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
         b)
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ModuleT m b
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     b
forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT (ModuleT m b
 -> ReaderT
      (RO m)
      (StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
      b)
-> (a -> ModuleT m b)
-> a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     b
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. String -> ModuleT m a
fail          = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ReaderT
   (RO m)
   (StateT
      ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
   a
 -> ModuleT m a)
-> (String
    -> ReaderT
         (RO m)
         (StateT
            ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
         a)
-> String
-> ModuleT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleError
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
forall a.
ModuleError
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModuleError
 -> ReaderT
      (RO m)
      (StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
      a)
-> (String -> ModuleError)
-> String
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleError
OtherFailure

instance MonadT ModuleT where
  {-# INLINE lift #-}
  lift :: forall (m :: * -> *) a. Monad m => m a -> ModuleT m a
lift = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ReaderT
   (RO m)
   (StateT
      ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
   a
 -> ModuleT m a)
-> (m a
    -> ReaderT
         (RO m)
         (StateT
            ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
         a)
-> m a
-> ModuleT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT
  ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
forall (m :: * -> *) a. Monad m => m a -> ReaderT (RO m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (StateT
   ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a
 -> ReaderT
      (RO m)
      (StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
      a)
-> (m a
    -> StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a)
-> m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptionT ModuleError (WriterT [ModuleWarning] m) a
-> StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a
forall (m :: * -> *) a. Monad m => m a -> StateT ModuleEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (ExceptionT ModuleError (WriterT [ModuleWarning] m) a
 -> StateT
      ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a)
-> (m a -> ExceptionT ModuleError (WriterT [ModuleWarning] m) a)
-> m a
-> StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [ModuleWarning] m a
-> ExceptionT ModuleError (WriterT [ModuleWarning] m) a
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptionT ModuleError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (WriterT [ModuleWarning] m a
 -> ExceptionT ModuleError (WriterT [ModuleWarning] m) a)
-> (m a -> WriterT [ModuleWarning] m a)
-> m a
-> ExceptionT ModuleError (WriterT [ModuleWarning] m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> WriterT [ModuleWarning] m a
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [ModuleWarning] m a
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 = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ReaderT
   (RO m)
   (StateT
      ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
   a
 -> ModuleT m a)
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
-> ModuleT m a
forall a b. (a -> b) -> a -> b
$
    do ModuleEnv
me <- ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get
       let (a
a,Supply
s') = Supply -> (a, Supply)
f (ModuleEnv -> Supply
meSupply ModuleEnv
me)
       ModuleEnv
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set (ModuleEnv
 -> ReaderT
      (RO m)
      (StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
      ())
-> ModuleEnv
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     ()
forall a b. (a -> b) -> a -> b
$! ModuleEnv
me { meSupply = s' }
       a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
forall a.
a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
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 = m a -> ModuleT m a
forall (m :: * -> *) a. Monad m => m a -> ModuleT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (m a -> ModuleT m a) -> m a -> ModuleT m a
forall a b. (a -> b) -> a -> b
$ IO a -> m a
forall a. IO a -> m a
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 -> String -> 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 =
    WriterT [ModuleWarning] m (Either ModuleError (a, ModuleEnv))
-> m (Either ModuleError (a, ModuleEnv), [ModuleWarning])
forall (m :: * -> *) i a. Monad m => WriterT i m a -> m (a, i)
runWriterT
  (WriterT [ModuleWarning] m (Either ModuleError (a, ModuleEnv))
 -> m (Either ModuleError (a, ModuleEnv), [ModuleWarning]))
-> WriterT [ModuleWarning] m (Either ModuleError (a, ModuleEnv))
-> m (Either ModuleError (a, ModuleEnv), [ModuleWarning])
forall a b. (a -> b) -> a -> b
$ ExceptionT ModuleError (WriterT [ModuleWarning] m) (a, ModuleEnv)
-> WriterT [ModuleWarning] m (Either ModuleError (a, ModuleEnv))
forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT
  (ExceptionT ModuleError (WriterT [ModuleWarning] m) (a, ModuleEnv)
 -> WriterT [ModuleWarning] m (Either ModuleError (a, ModuleEnv)))
-> ExceptionT
     ModuleError (WriterT [ModuleWarning] m) (a, ModuleEnv)
-> WriterT [ModuleWarning] m (Either ModuleError (a, ModuleEnv))
forall a b. (a -> b) -> a -> b
$ ModuleEnv
-> StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a
-> ExceptionT
     ModuleError (WriterT [ModuleWarning] m) (a, ModuleEnv)
forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT (ModuleInput m -> ModuleEnv
forall (m :: * -> *). ModuleInput m -> ModuleEnv
minpModuleEnv ModuleInput m
minp)
  (StateT
   ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a
 -> ExceptionT
      ModuleError (WriterT [ModuleWarning] m) (a, ModuleEnv))
-> StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a
-> ExceptionT
     ModuleError (WriterT [ModuleWarning] m) (a, ModuleEnv)
forall a b. (a -> b) -> a -> b
$ RO m
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
-> StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a
forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT (ModuleInput m -> RO m
forall (m :: * -> *). ModuleInput m -> RO m
emptyRO ModuleInput m
minp)
  (ReaderT
   (RO m)
   (StateT
      ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
   a
 -> StateT
      ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a)
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
-> StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)) a
forall a b. (a -> b) -> a -> b
$ ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
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 = ModuleInput IO
-> ModuleT IO a
-> IO (Either ModuleError (a, ModuleEnv), [ModuleWarning])
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 = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (IO a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
forall a.
IO a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
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 (String -> m ByteString)
getByteReader = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  (String -> m ByteString)
-> ModuleT m (String -> m ByteString)
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ReaderT
   (RO m)
   (StateT
      ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
   (String -> m ByteString)
 -> ModuleT m (String -> m ByteString))
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     (String -> m ByteString)
-> ModuleT m (String -> m ByteString)
forall a b. (a -> b) -> a -> b
$ do
  RO { roFileReader :: forall (m :: * -> *). RO m -> String -> m ByteString
roFileReader = String -> m ByteString
readFileBytes } <- ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  (RO m)
forall (m :: * -> *) i. ReaderM m i => m i
ask
  (String -> m ByteString)
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     (String -> m ByteString)
forall a.
a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return String -> m ByteString
readFileBytes

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

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

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

setModuleEnv :: Monad m => ModuleEnv -> ModuleT m ()
setModuleEnv :: forall (m :: * -> *). Monad m => ModuleEnv -> ModuleT m ()
setModuleEnv = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  ()
-> ModuleT m ()
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ReaderT
   (RO m)
   (StateT
      ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
   ()
 -> ModuleT m ())
-> (ModuleEnv
    -> ReaderT
         (RO m)
         (StateT
            ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
         ())
-> ModuleEnv
-> ModuleT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleEnv
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     ()
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 = ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  ()
-> ModuleT m ()
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ReaderT
   (RO m)
   (StateT
      ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
   ()
 -> ModuleT m ())
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     ()
-> ModuleT m ()
forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env <- ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get
  ModuleEnv
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set (ModuleEnv
 -> ReaderT
      (RO m)
      (StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
      ())
-> ModuleEnv
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     ()
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 = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  (Maybe (LoadedModuleG TCTopEntity))
-> ModuleM (Maybe (LoadedModuleG TCTopEntity))
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)))
   (Maybe (LoadedModuleG TCTopEntity))
 -> ModuleM (Maybe (LoadedModuleG TCTopEntity)))
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     (Maybe (LoadedModuleG TCTopEntity))
-> ModuleM (Maybe (LoadedModuleG TCTopEntity))
forall a b. (a -> b) -> a -> b
$
  do ModuleEnv
env <- ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get
     Maybe (LoadedModuleG TCTopEntity)
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     (Maybe (LoadedModuleG TCTopEntity))
forall a.
a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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 <- ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
-> ModuleT IO ModuleEnv
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)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get
     Bool -> ModuleM Bool
forall a. a -> ModuleT IO a
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  = ImportSource -> ModuleM a -> ModuleM a
forall a. ImportSource -> ModuleM a -> ModuleM a
loading (ImportSource -> ModuleM a -> ModuleM a)
-> (Located Import -> ImportSource)
-> Located Import
-> ModuleM a
-> ModuleM a
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  = ImportSource -> ModuleM a -> ModuleM a
forall a. ImportSource -> ModuleM a -> ModuleM a
loading (ImportSource -> ModuleM a -> ModuleM a)
-> (ModName -> ImportSource) -> ModName -> ModuleM a -> ModuleM a
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 = ImportSource -> ModuleM a -> ModuleM a
forall a. ImportSource -> ModuleM a -> ModuleM a
loading (ImportSource -> ModuleM a -> ModuleM a)
-> (Located ModName -> ImportSource)
-> Located ModName
-> ModuleM a
-> ModuleM a
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  = ModName -> ModuleM a -> ModuleM a
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 = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleM a
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
 -> ModuleM a)
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
-> ModuleM a
forall a b. (a -> b) -> a -> b
$ do
  RO IO
ro <- ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  (RO IO)
forall (m :: * -> *) i. ReaderM m i => m i
ask
  let new :: [ImportSource]
new = ImportSource
src ImportSource -> [ImportSource] -> [ImportSource]
forall a. a -> [a] -> [a]
: RO IO -> [ImportSource]
forall (m :: * -> *). RO m -> [ImportSource]
roLoading RO IO
ro

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

  RO IO
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
RO IO
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local RO IO
ro { roLoading = new } (ModuleM a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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  = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ImportSource
-> ModuleM ImportSource
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)))
   ImportSource
 -> ModuleM ImportSource)
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ImportSource
-> ModuleM ImportSource
forall a b. (a -> b) -> a -> b
$ do
  RO IO
ro <- ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  (RO IO)
forall (m :: * -> *) i. ReaderM m i => m i
ask
  case RO IO -> [ImportSource]
forall (m :: * -> *). RO m -> [ImportSource]
roLoading RO IO
ro of
    ImportSource
is : [ImportSource]
_ -> ImportSource
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ImportSource
forall a.
a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return ImportSource
is
    [ImportSource]
_      -> ImportSource
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ImportSource
forall a.
a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
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 (ModuleEnv -> Map ModName (Either ModParamNames Iface))
-> ModuleT IO ModuleEnv
-> ModuleM (Map ModName (Either ModParamNames Iface))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
-> ModuleT IO ModuleEnv
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)))
  ModuleEnv
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 (LoadedEntity -> Either ModParamNames Iface)
-> Map ModName LoadedEntity
-> Map ModName (Either ModParamNames Iface)
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 -> ModParamNames -> Either ModParamNames Iface
forall a b. a -> Either a b
Left (LoadedSignature -> ModParamNames
forall a. LoadedModuleG a -> a
lmData LoadedSignature
ifa)
      ALoadedFunctor LoadedModule
mo -> Iface -> Either ModParamNames Iface
forall a b. b -> Either a b
Right (LoadedModuleData -> Iface
lmdInterface (LoadedModule -> LoadedModuleData
forall a. LoadedModuleG a -> a
lmData LoadedModule
mo))
      ALoadedModule LoadedModule
mo -> Iface -> Either ModParamNames Iface
forall a b. b -> Either a b
Right (LoadedModuleData -> Iface
lmdInterface (LoadedModule -> LoadedModuleData
forall a. LoadedModuleG a -> a
lmData LoadedModule
mo))

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

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

getAllLoadedSignatures :: ModuleM (P.ModName -> Maybe T.ModParamNames)
getAllLoadedSignatures :: ModuleM (ModName -> Maybe ModParamNames)
getAllLoadedSignatures = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  (ModName -> Maybe ModParamNames)
-> ModuleM (ModName -> Maybe ModParamNames)
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT
  do ModuleEnv
env <- ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get
     (ModName -> Maybe ModParamNames)
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     (ModName -> Maybe ModParamNames)
forall a.
a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure \ModName
nm -> LoadedSignature -> ModParamNames
forall a. LoadedModuleG a -> a
lmData (LoadedSignature -> ModParamNames)
-> Maybe LoadedSignature -> Maybe ModParamNames
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  = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  NameSeeds
-> ModuleM NameSeeds
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> NameSeeds
meNameSeeds (ModuleEnv -> NameSeeds)
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     NameSeeds
forall a b.
(a -> b)
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get)

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

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

getEvalForeignPolicy :: ModuleM EvalForeignPolicy
getEvalForeignPolicy :: ModuleM EvalForeignPolicy
getEvalForeignPolicy = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  EvalForeignPolicy
-> ModuleM EvalForeignPolicy
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> EvalForeignPolicy
meEvalForeignPolicy (ModuleEnv -> EvalForeignPolicy)
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     EvalForeignPolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get)

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

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

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

unloadModule :: (forall a. LoadedModuleG a -> Bool) -> ModuleM ()
unloadModule :: (forall a. LoadedModuleG a -> Bool) -> ModuleM ()
unloadModule forall a. LoadedModuleG a -> Bool
rm = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ()
-> ModuleM ()
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)))
   ()
 -> ModuleM ())
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
-> ModuleM ()
forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env <- ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get
  ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set (ModuleEnv
 -> ReaderT
      (RO IO)
      (StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
      ())
-> ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meLoadedModules = removeLoadedModule rm (meLoadedModules 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 = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ()
-> ModuleM ()
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)))
   ()
 -> ModuleM ())
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
-> ModuleM ()
forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env <- ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get
  String
ident <- case ModulePath
path of
             InFile String
p  -> ModuleT IO String
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     String
forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT (ModuleT IO String
 -> ReaderT
      (RO IO)
      (StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
      String)
-> ModuleT IO String
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     String
forall a b. (a -> b) -> a -> b
$ IO String -> ModuleT IO String
forall (m :: * -> *) a. BaseM m IO => IO a -> ModuleT m a
io (String -> IO String
canonicalizePath String
p)
             InMem String
l ByteString
_ -> String
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     String
forall a.
a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
l

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

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

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

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

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

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

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

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

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

getSearchPath :: ModuleM [FilePath]
getSearchPath :: ModuleM [String]
getSearchPath  = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  [String]
-> ModuleM [String]
forall (m :: * -> *) a.
ReaderT
  (RO m)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
  a
-> ModuleT m a
ModuleT (ModuleEnv -> [String]
meSearchPath (ModuleEnv -> [String])
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     [String]
forall a b.
(a -> b)
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
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. [String] -> ModuleM a -> ModuleM a
withPrependedSearchPath [String]
fps ModuleM a
m = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  a
-> ModuleM a
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
 -> ModuleM a)
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
-> ModuleM a
forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
env0 <- ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get
  let fps0 :: [String]
fps0 = ModuleEnv -> [String]
meSearchPath ModuleEnv
env0
  ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set (ModuleEnv
 -> ReaderT
      (RO IO)
      (StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
      ())
-> ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
forall a b. (a -> b) -> a -> b
$! ModuleEnv
env0 { meSearchPath = fps ++ fps0 }
  a
x <- ModuleM a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
     (RO m)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
     a
unModuleT ModuleM a
m
  ModuleEnv
env <- ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get
  ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set (ModuleEnv
 -> ReaderT
      (RO IO)
      (StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
      ())
-> ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meSearchPath = fps0 }
  a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall a.
a
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

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

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

setDynEnv :: DynamicEnv -> ModuleM ()
setDynEnv :: DynamicEnv -> ModuleM ()
setDynEnv DynamicEnv
denv = ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ()
-> ModuleM ()
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)))
   ()
 -> ModuleM ())
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
-> ModuleM ()
forall a b. (a -> b) -> a -> b
$ do
  ModuleEnv
me <- ReaderT
  (RO IO)
  (StateT
     ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
  ModuleEnv
forall (m :: * -> *) i. StateM m i => m i
get
  ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set (ModuleEnv
 -> ReaderT
      (RO IO)
      (StateT
         ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
      ())
-> ModuleEnv
-> ReaderT
     (RO IO)
     (StateT
        ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
     ()
forall a b. (a -> b) -> a -> b
$! ModuleEnv
me { meDynEnv = 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
                    IO b -> ModuleM b
forall (m :: * -> *) a. BaseM m IO => IO a -> ModuleT m a
io (Logger -> a -> IO b
f (EvalOpts -> Logger
evalLogger EvalOpts
l) a
a)