{-# 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
data ImportSource
= FromModule P.ModName
| FromImport (Located P.Import)
| FromSigImport (Located P.ModName)
| FromModuleInstance (Located P.ModName)
deriving (Int -> ImportSource -> ShowS
[ImportSource] -> ShowS
ImportSource -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ImportSource] -> ShowS
$cshowList :: [ImportSource] -> ShowS
show :: ImportSource -> [Char]
$cshow :: ImportSource -> [Char]
showsPrec :: Int -> ImportSource -> ShowS
$cshowsPrec :: Int -> ImportSource -> ShowS
Show, forall x. Rep ImportSource x -> ImportSource
forall x. ImportSource -> Rep ImportSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportSource x -> ImportSource
$cfrom :: forall x. ImportSource -> Rep ImportSource x
Generic, ImportSource -> ()
forall a. (a -> ()) -> NFData a
rnf :: ImportSource -> ()
$crnf :: ImportSource -> ()
NFData)
instance Eq ImportSource where
== :: ImportSource -> ImportSource -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportSource -> ModName
importedModule
instance PP ImportSource where
ppPrec :: Int -> ImportSource -> Doc
ppPrec Int
_ ImportSource
is = case ImportSource
is of
FromModule ModName
n -> [Char] -> Doc
text [Char]
"module name" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModName
n
FromImport Located Import
li -> [Char] -> Doc
text [Char]
"import of module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall mname. ImportG mname -> mname
P.iModule (forall a. Located a -> a
P.thing Located Import
li))
FromSigImport Located ModName
l -> [Char] -> Doc
text [Char]
"import of interface" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
P.thing Located ModName
l)
FromModuleInstance Located ModName
l ->
[Char] -> Doc
text [Char]
"instantiation of module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
P.thing Located ModName
l)
importedModule :: ImportSource -> P.ModName
importedModule :: ImportSource -> ModName
importedModule ImportSource
is =
case ImportSource
is of
FromModule ModName
n -> ModName
n
FromImport Located Import
li -> forall mname. ImportG mname -> mname
P.iModule (forall a. Located a -> a
P.thing Located Import
li)
FromModuleInstance Located ModName
l -> forall a. Located a -> a
P.thing Located ModName
l
FromSigImport Located ModName
l -> forall a. Located a -> a
P.thing Located ModName
l
data ModuleError
= ModuleNotFound P.ModName [FilePath]
| CantFindFile FilePath
| BadUtf8 ModulePath UnicodeException
| OtherIOError FilePath IOException
| ModuleParseError ModulePath Parser.ParseError
| RecursiveModules [ImportSource]
| RenamerErrors ImportSource [RenamerError]
| NoPatErrors ImportSource [NoPat.Error]
| ExpandPropGuardsError ImportSource ExpandPropGuards.Error
| NoIncludeErrors ImportSource [NoInc.IncludeError]
| TypeCheckingFailed ImportSource T.NameMap [(Range,T.Error)]
| OtherFailure String
| ModuleNameMismatch P.ModName (Located P.ModName)
| DuplicateModuleName P.ModName FilePath FilePath
| FFILoadErrors P.ModName [FFILoadError]
| ErrorInFile ModulePath ModuleError
deriving (Int -> ModuleError -> ShowS
[ModuleError] -> ShowS
ModuleError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ModuleError] -> ShowS
$cshowList :: [ModuleError] -> ShowS
show :: ModuleError -> [Char]
$cshow :: ModuleError -> [Char]
showsPrec :: Int -> ModuleError -> ShowS
$cshowsPrec :: Int -> ModuleError -> ShowS
Show)
instance NFData ModuleError where
rnf :: ModuleError -> ()
rnf ModuleError
e = case ModuleError
e of
ModuleNotFound ModName
src [[Char]]
path -> ModName
src forall a b. NFData a => a -> b -> b
`deepseq` [[Char]]
path forall a b. NFData a => a -> b -> b
`deepseq` ()
CantFindFile [Char]
path -> [Char]
path forall a b. NFData a => a -> b -> b
`deepseq` ()
BadUtf8 ModulePath
path UnicodeException
ue -> forall a. NFData a => a -> ()
rnf (ModulePath
path, UnicodeException
ue)
OtherIOError [Char]
path IOException
exn -> [Char]
path forall a b. NFData a => a -> b -> b
`deepseq` IOException
exn seq :: forall a b. a -> b -> b
`seq` ()
ModuleParseError ModulePath
source ParseError
err -> ModulePath
source forall a b. NFData a => a -> b -> b
`deepseq` ParseError
err forall a b. NFData a => a -> b -> b
`deepseq` ()
RecursiveModules [ImportSource]
mods -> [ImportSource]
mods forall a b. NFData a => a -> b -> b
`deepseq` ()
RenamerErrors ImportSource
src [RenamerError]
errs -> ImportSource
src forall a b. NFData a => a -> b -> b
`deepseq` [RenamerError]
errs forall a b. NFData a => a -> b -> b
`deepseq` ()
NoPatErrors ImportSource
src [Error]
errs -> ImportSource
src forall a b. NFData a => a -> b -> b
`deepseq` [Error]
errs forall a b. NFData a => a -> b -> b
`deepseq` ()
ExpandPropGuardsError ImportSource
src Error
err -> ImportSource
src forall a b. NFData a => a -> b -> b
`deepseq` Error
err forall a b. NFData a => a -> b -> b
`deepseq` ()
NoIncludeErrors ImportSource
src [IncludeError]
errs -> ImportSource
src forall a b. NFData a => a -> b -> b
`deepseq` [IncludeError]
errs forall a b. NFData a => a -> b -> b
`deepseq` ()
TypeCheckingFailed ImportSource
nm NameMap
src [(Range, Error)]
errs -> ImportSource
nm forall a b. NFData a => a -> b -> b
`deepseq` NameMap
src forall a b. NFData a => a -> b -> b
`deepseq` [(Range, Error)]
errs forall a b. NFData a => a -> b -> b
`deepseq` ()
ModuleNameMismatch ModName
expected Located ModName
found ->
ModName
expected forall a b. NFData a => a -> b -> b
`deepseq` Located ModName
found forall a b. NFData a => a -> b -> b
`deepseq` ()
DuplicateModuleName ModName
name [Char]
path1 [Char]
path2 ->
ModName
name forall a b. NFData a => a -> b -> b
`deepseq` [Char]
path1 forall a b. NFData a => a -> b -> b
`deepseq` [Char]
path2 forall a b. NFData a => a -> b -> b
`deepseq` ()
OtherFailure [Char]
x -> [Char]
x forall a b. NFData a => a -> b -> b
`deepseq` ()
FFILoadErrors ModName
x [FFILoadError]
errs -> ModName
x forall a b. NFData a => a -> b -> b
`deepseq` [FFILoadError]
errs forall a b. NFData a => a -> b -> b
`deepseq` ()
ErrorInFile ModulePath
x ModuleError
y -> ModulePath
x forall a b. NFData a => a -> b -> b
`deepseq` ModuleError
y forall a b. NFData a => a -> b -> b
`deepseq` ()
instance PP ModuleError where
ppPrec :: Int -> ModuleError -> Doc
ppPrec Int
prec ModuleError
e = case ModuleError
e of
ModuleNotFound ModName
src [[Char]]
path ->
[Char] -> Doc
text [Char]
"[error]" Doc -> Doc -> Doc
<+>
[Char] -> Doc
text [Char]
"Could not find module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModName
src
Doc -> Doc -> Doc
$$
Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"Searched paths:")
Int
4 ([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc
text [[Char]]
path))
Doc -> Doc -> Doc
$$
[Char] -> Doc
text [Char]
"Set the CRYPTOLPATH environment variable to search more directories"
CantFindFile [Char]
path ->
[Char] -> Doc
text [Char]
"[error]" Doc -> Doc -> Doc
<+>
[Char] -> Doc
text [Char]
"can't find file:" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
path
BadUtf8 ModulePath
path UnicodeException
_ue ->
[Char] -> Doc
text [Char]
"[error]" Doc -> Doc -> Doc
<+>
[Char] -> Doc
text [Char]
"bad utf-8 encoding:" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModulePath
path
OtherIOError [Char]
path IOException
exn ->
Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"[error]" Doc -> Doc -> Doc
<+>
[Char] -> Doc
text [Char]
"IO error while loading file:" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
path Doc -> Doc -> Doc
<.> Doc
colon)
Int
4 ([Char] -> Doc
text (forall a. Show a => a -> [Char]
show IOException
exn))
ModuleParseError ModulePath
_source ParseError
err -> ParseError -> Doc
Parser.ppError ParseError
err
RecursiveModules [ImportSource]
mods ->
Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"[error] module imports form a cycle:")
Int
4 ([Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp (forall a. [a] -> [a]
reverse [ImportSource]
mods)))
RenamerErrors ImportSource
_src [RenamerError]
errs -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp [RenamerError]
errs)
NoPatErrors ImportSource
_src [Error]
errs -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp [Error]
errs)
ExpandPropGuardsError ImportSource
_src Error
err -> forall a. PP a => a -> Doc
pp Error
err
NoIncludeErrors ImportSource
_src [IncludeError]
errs -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map IncludeError -> Doc
NoInc.ppIncludeError [IncludeError]
errs)
TypeCheckingFailed ImportSource
_src NameMap
nm [(Range, Error)]
errs -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (NameMap -> (Range, Error) -> Doc
T.ppNamedError NameMap
nm) [(Range, Error)]
errs)
ModuleNameMismatch ModName
expected Located ModName
found ->
Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"[error]" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> Range
P.srcRange Located ModName
found) Doc -> Doc -> Doc
<.> Char -> Doc
char Char
':')
Int
4 ([Doc] -> Doc
vcat [ [Char] -> Doc
text [Char]
"File name does not match module name:"
, [Char] -> Doc
text [Char]
" Actual:" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
P.thing Located ModName
found)
, [Char] -> Doc
text [Char]
"Expected:" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModName
expected
])
DuplicateModuleName ModName
name [Char]
path1 [Char]
path2 ->
Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"[error] module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModName
name Doc -> Doc -> Doc
<+>
[Char] -> Doc
text [Char]
"is defined in multiple files:")
Int
4 ([Doc] -> Doc
vcat [[Char] -> Doc
text [Char]
path1, [Char] -> Doc
text [Char]
path2])
OtherFailure [Char]
x -> [Char] -> Doc
text [Char]
x
FFILoadErrors ModName
x [FFILoadError]
errs ->
Doc -> Int -> Doc -> Doc
hang ([Char] -> Doc
text [Char]
"[error] Failed to load foreign implementations for module"
Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp ModName
x Doc -> Doc -> Doc
<.> Doc
colon)
Int
4 ([Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp [FFILoadError]
errs)
ErrorInFile ModulePath
_ ModuleError
x -> forall a. PP a => Int -> a -> Doc
ppPrec Int
prec ModuleError
x
moduleNotFound :: P.ModName -> [FilePath] -> ModuleM a
moduleNotFound :: forall a. ModName -> [[Char]] -> ModuleM a
moduleNotFound ModName
name [[Char]]
paths = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModName -> [[Char]] -> ModuleError
ModuleNotFound ModName
name [[Char]]
paths))
cantFindFile :: FilePath -> ModuleM a
cantFindFile :: forall a. [Char] -> ModuleM a
cantFindFile [Char]
path = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ([Char] -> ModuleError
CantFindFile [Char]
path))
badUtf8 :: ModulePath -> UnicodeException -> ModuleM a
badUtf8 :: forall a. ModulePath -> UnicodeException -> ModuleM a
badUtf8 ModulePath
path UnicodeException
ue = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModulePath -> UnicodeException -> ModuleError
BadUtf8 ModulePath
path UnicodeException
ue))
otherIOError :: FilePath -> IOException -> ModuleM a
otherIOError :: forall a. [Char] -> IOException -> ModuleM a
otherIOError [Char]
path IOException
exn = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ([Char] -> IOException -> ModuleError
OtherIOError [Char]
path IOException
exn))
moduleParseError :: ModulePath -> Parser.ParseError -> ModuleM a
moduleParseError :: forall a. ModulePath -> ParseError -> ModuleM a
moduleParseError ModulePath
path ParseError
err =
forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModulePath -> ParseError -> ModuleError
ModuleParseError ModulePath
path ParseError
err))
recursiveModules :: [ImportSource] -> ModuleM a
recursiveModules :: forall a. [ImportSource] -> ModuleM a
recursiveModules [ImportSource]
loaded = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ([ImportSource] -> ModuleError
RecursiveModules [ImportSource]
loaded))
renamerErrors :: [RenamerError] -> ModuleM a
renamerErrors :: forall a. [RenamerError] -> ModuleM a
renamerErrors [RenamerError]
errs = do
ImportSource
src <- ModuleM ImportSource
getImportSource
forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ImportSource -> [RenamerError] -> ModuleError
RenamerErrors ImportSource
src [RenamerError]
errs))
noPatErrors :: [NoPat.Error] -> ModuleM a
noPatErrors :: forall a. [Error] -> ModuleM a
noPatErrors [Error]
errs = do
ImportSource
src <- ModuleM ImportSource
getImportSource
forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ImportSource -> [Error] -> ModuleError
NoPatErrors ImportSource
src [Error]
errs))
expandPropGuardsError :: ExpandPropGuards.Error -> ModuleM a
expandPropGuardsError :: forall a. Error -> ModuleM a
expandPropGuardsError Error
err = do
ImportSource
src <- ModuleM ImportSource
getImportSource
forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ImportSource -> Error -> ModuleError
ExpandPropGuardsError ImportSource
src Error
err))
noIncludeErrors :: [NoInc.IncludeError] -> ModuleM a
noIncludeErrors :: forall a. [IncludeError] -> ModuleM a
noIncludeErrors [IncludeError]
errs = do
ImportSource
src <- ModuleM ImportSource
getImportSource
forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ImportSource -> [IncludeError] -> ModuleError
NoIncludeErrors ImportSource
src [IncludeError]
errs))
typeCheckingFailed :: T.NameMap -> [(Range,T.Error)] -> ModuleM a
typeCheckingFailed :: forall a. NameMap -> [(Range, Error)] -> ModuleM a
typeCheckingFailed NameMap
nameMap [(Range, Error)]
errs = do
ImportSource
src <- ModuleM ImportSource
getImportSource
forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ImportSource -> NameMap -> [(Range, Error)] -> ModuleError
TypeCheckingFailed ImportSource
src NameMap
nameMap [(Range, Error)]
errs))
moduleNameMismatch :: P.ModName -> Located P.ModName -> ModuleM a
moduleNameMismatch :: forall a. ModName -> Located ModName -> ModuleM a
moduleNameMismatch ModName
expected Located ModName
found =
forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModName -> Located ModName -> ModuleError
ModuleNameMismatch ModName
expected Located ModName
found))
duplicateModuleName :: P.ModName -> FilePath -> FilePath -> ModuleM a
duplicateModuleName :: forall a. ModName -> [Char] -> [Char] -> ModuleM a
duplicateModuleName ModName
name [Char]
path1 [Char]
path2 =
forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModName -> [Char] -> [Char] -> ModuleError
DuplicateModuleName ModName
name [Char]
path1 [Char]
path2))
ffiLoadErrors :: P.ModName -> [FFILoadError] -> ModuleM a
ffiLoadErrors :: forall a. ModName -> [FFILoadError] -> ModuleM a
ffiLoadErrors ModName
x [FFILoadError]
errs = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise (ModName -> [FFILoadError] -> ModuleError
FFILoadErrors ModName
x [FFILoadError]
errs))
errorInFile :: ModulePath -> ModuleM a -> ModuleM a
errorInFile :: forall a. ModulePath -> ModuleM a -> ModuleM a
errorInFile ModulePath
file (ModuleT ReaderT
(RO IO)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
a
m) = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (ReaderT
(RO IO)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] IO)))
a
m forall (m :: * -> *) x a.
RunExceptionM m x =>
m a -> (x -> m a) -> m a
`handle` forall {m :: * -> *} {a}.
ExceptionM m ModuleError =>
ModuleError -> m a
h)
where h :: ModuleError -> m a
h ModuleError
e = forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise forall a b. (a -> b) -> a -> b
$ case ModuleError
e of
ErrorInFile {} -> ModuleError
e
ModuleError
_ -> ModulePath -> ModuleError -> ModuleError
ErrorInFile ModulePath
file ModuleError
e
data ModuleWarning
= TypeCheckWarnings T.NameMap [(Range,T.Warning)]
| RenamerWarnings [RenamerWarning]
deriving (Int -> ModuleWarning -> ShowS
[ModuleWarning] -> ShowS
ModuleWarning -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ModuleWarning] -> ShowS
$cshowList :: [ModuleWarning] -> ShowS
show :: ModuleWarning -> [Char]
$cshow :: ModuleWarning -> [Char]
showsPrec :: Int -> ModuleWarning -> ShowS
$cshowsPrec :: Int -> ModuleWarning -> ShowS
Show, forall x. Rep ModuleWarning x -> ModuleWarning
forall x. ModuleWarning -> Rep ModuleWarning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModuleWarning x -> ModuleWarning
$cfrom :: forall x. ModuleWarning -> Rep ModuleWarning x
Generic, ModuleWarning -> ()
forall a. (a -> ()) -> NFData a
rnf :: ModuleWarning -> ()
$crnf :: ModuleWarning -> ()
NFData)
instance PP ModuleWarning where
ppPrec :: Int -> ModuleWarning -> Doc
ppPrec Int
_ ModuleWarning
w = case ModuleWarning
w of
TypeCheckWarnings NameMap
nm [(Range, Warning)]
ws -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (NameMap -> (Range, Warning) -> Doc
T.ppNamedWarning NameMap
nm) [(Range, Warning)]
ws)
RenamerWarnings [RenamerWarning]
ws -> [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp [RenamerWarning]
ws)
warn :: [ModuleWarning] -> ModuleM ()
warn :: [ModuleWarning] -> ModuleM ()
warn = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) i. WriterM m i => i -> m ()
put
typeCheckWarnings :: T.NameMap -> [(Range,T.Warning)] -> ModuleM ()
typeCheckWarnings :: NameMap -> [(Range, Warning)] -> ModuleM ()
typeCheckWarnings NameMap
nameMap [(Range, Warning)]
ws
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Range, Warning)]
ws = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = [ModuleWarning] -> ModuleM ()
warn [NameMap -> [(Range, Warning)] -> ModuleWarning
TypeCheckWarnings NameMap
nameMap [(Range, Warning)]
ws]
renamerWarnings :: [RenamerWarning] -> ModuleM ()
renamerWarnings :: [RenamerWarning] -> ModuleM ()
renamerWarnings [RenamerWarning]
ws
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RenamerWarning]
ws = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = [ModuleWarning] -> ModuleM ()
warn [[RenamerWarning] -> ModuleWarning
RenamerWarnings [RenamerWarning]
ws]
data RO m =
RO { forall (m :: * -> *). RO m -> [ImportSource]
roLoading :: [ImportSource]
, forall (m :: * -> *). RO m -> m EvalOpts
roEvalOpts :: m EvalOpts
, forall (m :: * -> *). RO m -> Bool
roCallStacks :: Bool
, forall (m :: * -> *). RO m -> [Char] -> m ByteString
roFileReader :: FilePath -> m ByteString
, forall (m :: * -> *). RO m -> Solver
roTCSolver :: SMT.Solver
}
emptyRO :: ModuleInput m -> RO m
emptyRO :: forall (m :: * -> *). ModuleInput m -> RO m
emptyRO ModuleInput m
minp =
RO { roLoading :: [ImportSource]
roLoading = []
, roEvalOpts :: m EvalOpts
roEvalOpts = forall (m :: * -> *). ModuleInput m -> m EvalOpts
minpEvalOpts ModuleInput m
minp
, roCallStacks :: Bool
roCallStacks = forall (m :: * -> *). ModuleInput m -> Bool
minpCallStacks ModuleInput m
minp
, roFileReader :: [Char] -> m ByteString
roFileReader = forall (m :: * -> *). ModuleInput m -> [Char] -> m ByteString
minpByteReader ModuleInput m
minp
, roTCSolver :: Solver
roTCSolver = forall (m :: * -> *). ModuleInput m -> Solver
minpTCSolver ModuleInput m
minp
}
newtype ModuleT m a = ModuleT
{ forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
unModuleT :: ReaderT (RO m)
(StateT ModuleEnv
(ExceptionT ModuleError
(WriterT [ModuleWarning] m))) a
}
instance Monad m => Functor (ModuleT m) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> ModuleT m a -> ModuleT m b
fmap a -> b
f ModuleT m a
m = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
unModuleT ModuleT m a
m))
instance Monad m => Applicative (ModuleT m) where
{-# INLINE pure #-}
pure :: forall a. a -> ModuleT m a
pure a
x = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
{-# INLINE (<*>) #-}
ModuleT m (a -> b)
l <*> :: forall a b. ModuleT m (a -> b) -> ModuleT m a -> ModuleT m b
<*> ModuleT m a
r = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
unModuleT ModuleT m (a -> b)
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
unModuleT ModuleT m a
r)
instance Monad m => Monad (ModuleT m) where
{-# INLINE return #-}
return :: forall a. a -> ModuleT m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE (>>=) #-}
ModuleT m a
m >>= :: forall a b. ModuleT m a -> (a -> ModuleT m b) -> ModuleT m b
>>= a -> ModuleT m b
f = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
unModuleT ModuleT m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
unModuleT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ModuleT m b
f)
instance Fail.MonadFail m => Fail.MonadFail (ModuleT m) where
{-# INLINE fail #-}
fail :: forall a. [Char] -> ModuleT m a
fail = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ModuleError
OtherFailure
instance MonadT ModuleT where
{-# INLINE lift #-}
lift :: forall (m :: * -> *) a. Monad m => m a -> ModuleT m a
lift = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift
instance Monad m => FreshM (ModuleT m) where
liftSupply :: forall a. (Supply -> (a, Supply)) -> ModuleT m a
liftSupply Supply -> (a, Supply)
f = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$
do ModuleEnv
me <- forall (m :: * -> *) i. StateM m i => m i
get
let (a
a,Supply
s') = Supply -> (a, Supply)
f (ModuleEnv -> Supply
meSupply ModuleEnv
me)
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
me { meSupply :: Supply
meSupply = Supply
s' }
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
instance MonadIO m => MonadIO (ModuleT m) where
liftIO :: forall a. IO a -> ModuleT m a
liftIO IO a
m = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m
data ModuleInput m =
ModuleInput
{ forall (m :: * -> *). ModuleInput m -> Bool
minpCallStacks :: Bool
, forall (m :: * -> *). ModuleInput m -> m EvalOpts
minpEvalOpts :: m EvalOpts
, forall (m :: * -> *). ModuleInput m -> [Char] -> m ByteString
minpByteReader :: FilePath -> m ByteString
, forall (m :: * -> *). ModuleInput m -> ModuleEnv
minpModuleEnv :: ModuleEnv
, forall (m :: * -> *). ModuleInput m -> Solver
minpTCSolver :: SMT.Solver
}
runModuleT ::
Monad m =>
ModuleInput m ->
ModuleT m a ->
m (Either ModuleError (a, ModuleEnv), [ModuleWarning])
runModuleT :: forall (m :: * -> *) a.
Monad m =>
ModuleInput m
-> ModuleT m a
-> m (Either ModuleError (a, ModuleEnv), [ModuleWarning])
runModuleT ModuleInput m
minp ModuleT m a
m =
forall (m :: * -> *) i a. Monad m => WriterT i m a -> m (a, i)
runWriterT
forall a b. (a -> b) -> a -> b
$ forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT
forall a b. (a -> b) -> a -> b
$ forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT (forall (m :: * -> *). ModuleInput m -> ModuleEnv
minpModuleEnv ModuleInput m
minp)
forall a b. (a -> b) -> a -> b
$ forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT (forall (m :: * -> *). ModuleInput m -> RO m
emptyRO ModuleInput m
minp)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
unModuleT ModuleT m a
m
type ModuleM = ModuleT IO
runModuleM ::
ModuleInput IO ->
ModuleM a ->
IO (Either ModuleError (a,ModuleEnv),[ModuleWarning])
runModuleM :: forall a.
ModuleInput IO
-> ModuleM a
-> IO (Either ModuleError (a, ModuleEnv), [ModuleWarning])
runModuleM = forall (m :: * -> *) a.
Monad m =>
ModuleInput m
-> ModuleT m a
-> m (Either ModuleError (a, ModuleEnv), [ModuleWarning])
runModuleT
io :: BaseM m IO => IO a -> ModuleT m a
io :: forall (m :: * -> *) a. BaseM m IO => IO a -> ModuleT m a
io IO a
m = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *) (n :: * -> *) a. BaseM m n => n a -> m a
inBase IO a
m)
getByteReader :: Monad m => ModuleT m (FilePath -> m ByteString)
getByteReader :: forall (m :: * -> *). Monad m => ModuleT m ([Char] -> m ByteString)
getByteReader = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
RO { roFileReader :: forall (m :: * -> *). RO m -> [Char] -> m ByteString
roFileReader = [Char] -> m ByteString
readFileBytes } <- forall (m :: * -> *) i. ReaderM m i => m i
ask
forall (m :: * -> *) a. Monad m => a -> m a
return [Char] -> m ByteString
readFileBytes
getCallStacks :: Monad m => ModuleT m Bool
getCallStacks :: forall (m :: * -> *). Monad m => ModuleT m Bool
getCallStacks = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *). RO m -> Bool
roCallStacks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. ReaderM m i => m i
ask)
readBytes :: Monad m => FilePath -> ModuleT m ByteString
readBytes :: forall (m :: * -> *). Monad m => [Char] -> ModuleT m ByteString
readBytes [Char]
fn = do
[Char] -> m ByteString
fileReader <- forall (m :: * -> *). Monad m => ModuleT m ([Char] -> m ByteString)
getByteReader
forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ [Char] -> m ByteString
fileReader [Char]
fn
getModuleEnv :: Monad m => ModuleT m ModuleEnv
getModuleEnv :: forall (m :: * -> *). Monad m => ModuleT m ModuleEnv
getModuleEnv = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall (m :: * -> *) i. StateM m i => m i
get
getTCSolver :: Monad m => ModuleT m SMT.Solver
getTCSolver :: forall (m :: * -> *). Monad m => ModuleT m Solver
getTCSolver = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *). RO m -> Solver
roTCSolver forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. ReaderM m i => m i
ask)
setModuleEnv :: Monad m => ModuleEnv -> ModuleT m ()
setModuleEnv :: forall (m :: * -> *). Monad m => ModuleEnv -> ModuleT m ()
setModuleEnv = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) i. StateM m i => i -> m ()
set
modifyModuleEnv :: Monad m => (ModuleEnv -> ModuleEnv) -> ModuleT m ()
modifyModuleEnv :: forall (m :: * -> *).
Monad m =>
(ModuleEnv -> ModuleEnv) -> ModuleT m ()
modifyModuleEnv ModuleEnv -> ModuleEnv
f = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv -> ModuleEnv
f ModuleEnv
env
getLoadedMaybe :: P.ModName -> ModuleM (Maybe (LoadedModuleG T.TCTopEntity))
getLoadedMaybe :: ModName -> ModuleM (Maybe (LoadedModuleG TCTopEntity))
getLoadedMaybe ModName
mn = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$
do ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
forall (m :: * -> *) a. Monad m => a -> m a
return (ModName -> ModuleEnv -> Maybe (LoadedModuleG TCTopEntity)
lookupTCEntity ModName
mn ModuleEnv
env)
isLoaded :: P.ModName -> ModuleM Bool
isLoaded :: ModName -> ModuleM Bool
isLoaded ModName
mn =
do ModuleEnv
env <- forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall (m :: * -> *) i. StateM m i => m i
get
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModName -> LoadedModules -> Bool
MEnv.isLoaded ModName
mn (ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
env))
loadingImport :: Located P.Import -> ModuleM a -> ModuleM a
loadingImport :: forall a. Located Import -> ModuleM a -> ModuleM a
loadingImport = forall a. ImportSource -> ModuleM a -> ModuleM a
loading forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Import -> ImportSource
FromImport
loadingModule :: P.ModName -> ModuleM a -> ModuleM a
loadingModule :: forall a. ModName -> ModuleM a -> ModuleM a
loadingModule = forall a. ImportSource -> ModuleM a -> ModuleM a
loading forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModName -> ImportSource
FromModule
loadingModInstance :: Located P.ModName -> ModuleM a -> ModuleM a
loadingModInstance :: forall a. Located ModName -> ModuleM a -> ModuleM a
loadingModInstance = forall a. ImportSource -> ModuleM a -> ModuleM a
loading forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModName -> ImportSource
FromModuleInstance
interactive :: ModuleM a -> ModuleM a
interactive :: forall a. ModuleM a -> ModuleM a
interactive = forall a. ModName -> ModuleM a -> ModuleM a
loadingModule ModName
interactiveName
loading :: ImportSource -> ModuleM a -> ModuleM a
loading :: forall a. ImportSource -> ModuleM a -> ModuleM a
loading ImportSource
src ModuleM a
m = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
RO IO
ro <- forall (m :: * -> *) i. ReaderM m i => m i
ask
let new :: [ImportSource]
new = ImportSource
src forall a. a -> [a] -> [a]
: forall (m :: * -> *). RO m -> [ImportSource]
roLoading RO IO
ro
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ImportSource
src forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall (m :: * -> *). RO m -> [ImportSource]
roLoading RO IO
ro) (forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ([ImportSource] -> ModuleError
RecursiveModules [ImportSource]
new))
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local RO IO
ro { roLoading :: [ImportSource]
roLoading = [ImportSource]
new } (forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
unModuleT ModuleM a
m)
getImportSource :: ModuleM ImportSource
getImportSource :: ModuleM ImportSource
getImportSource = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
RO IO
ro <- forall (m :: * -> *) i. ReaderM m i => m i
ask
case forall (m :: * -> *). RO m -> [ImportSource]
roLoading RO IO
ro of
ImportSource
is : [ImportSource]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ImportSource
is
[ImportSource]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (ModName -> ImportSource
FromModule ModName
noModuleName)
getIfaces :: ModuleM (Map P.ModName (Either T.ModParamNames Iface))
getIfaces :: ModuleM (Map ModName (Either ModParamNames Iface))
getIfaces = ModuleEnv -> Map ModName (Either ModParamNames Iface)
toMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall (m :: * -> *) i. StateM m i => m i
get
where
toMap :: ModuleEnv -> Map ModName (Either ModParamNames Iface)
toMap ModuleEnv
env = LoadedEntity -> Either ModParamNames Iface
cvt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadedModules -> Map ModName LoadedEntity
getLoadedEntities (ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
env)
cvt :: LoadedEntity -> Either ModParamNames Iface
cvt LoadedEntity
ent =
case LoadedEntity
ent of
ALoadedInterface LoadedSignature
ifa -> forall a b. a -> Either a b
Left (forall a. LoadedModuleG a -> a
lmData LoadedSignature
ifa)
ALoadedFunctor LoadedModule
mo -> forall a b. b -> Either a b
Right (LoadedModuleData -> Iface
lmdInterface (forall a. LoadedModuleG a -> a
lmData LoadedModule
mo))
ALoadedModule LoadedModule
mo -> forall a b. b -> Either a b
Right (LoadedModuleData -> Iface
lmdInterface (forall a. LoadedModuleG a -> a
lmData LoadedModule
mo))
getLoaded :: P.ModName -> ModuleM T.Module
getLoaded :: ModName -> ModuleM Module
getLoaded ModName
mn = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$
do ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
case ModName -> ModuleEnv -> Maybe LoadedModule
lookupModule ModName
mn ModuleEnv
env of
Just LoadedModule
lm -> forall (m :: * -> *) a. Monad m => a -> m a
return (LoadedModule -> Module
lmModule LoadedModule
lm)
Maybe LoadedModule
Nothing -> forall a. HasCallStack => [Char] -> [[Char]] -> a
panic [Char]
"ModuleSystem" [[Char]
"Module not available", forall a. Show a => a -> [Char]
show (forall a. PP a => a -> Doc
pp ModName
mn) ]
getAllLoaded :: ModuleM (P.ModName -> Maybe (T.ModuleG (), IfaceG ()))
getAllLoaded :: ModuleM (ModName -> Maybe (ModuleG (), IfaceG ()))
getAllLoaded = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT
do ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
forall (f :: * -> *) a. Applicative f => a -> f a
pure \ModName
nm -> do LoadedModule
lm <- ModName -> ModuleEnv -> Maybe LoadedModule
lookupModule ModName
nm ModuleEnv
env
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( (LoadedModule -> Module
lmModule LoadedModule
lm) { mName :: ()
T.mName = () }
, forall name. IfaceG name -> IfaceG ()
ifaceForgetName (LoadedModule -> Iface
lmInterface LoadedModule
lm)
)
getAllLoadedSignatures :: ModuleM (P.ModName -> Maybe T.ModParamNames)
getAllLoadedSignatures :: ModuleM (ModName -> Maybe ModParamNames)
getAllLoadedSignatures = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT
do ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
forall (f :: * -> *) a. Applicative f => a -> f a
pure \ModName
nm -> forall a. LoadedModuleG a -> a
lmData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModName -> ModuleEnv -> Maybe LoadedSignature
lookupSignature ModName
nm ModuleEnv
env
getNameSeeds :: ModuleM T.NameSeeds
getNameSeeds :: ModuleM NameSeeds
getNameSeeds = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (ModuleEnv -> NameSeeds
meNameSeeds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)
getSupply :: ModuleM Supply
getSupply :: ModuleM Supply
getSupply = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (ModuleEnv -> Supply
meSupply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)
getMonoBinds :: ModuleM Bool
getMonoBinds :: ModuleM Bool
getMonoBinds = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (ModuleEnv -> Bool
meMonoBinds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)
setMonoBinds :: Bool -> ModuleM ()
setMonoBinds :: Bool -> ModuleM ()
setMonoBinds Bool
b = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meMonoBinds :: Bool
meMonoBinds = Bool
b }
setNameSeeds :: T.NameSeeds -> ModuleM ()
setNameSeeds :: NameSeeds -> ModuleM ()
setNameSeeds NameSeeds
seeds = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meNameSeeds :: NameSeeds
meNameSeeds = NameSeeds
seeds }
setSupply :: Supply -> ModuleM ()
setSupply :: Supply -> ModuleM ()
setSupply Supply
supply = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$
do ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meSupply :: Supply
meSupply = Supply
supply }
unloadModule :: (forall a. LoadedModuleG a -> Bool) -> ModuleM ()
unloadModule :: (forall a. LoadedModuleG a -> Bool) -> ModuleM ()
unloadModule forall a. LoadedModuleG a -> Bool
rm = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meLoadedModules :: LoadedModules
meLoadedModules = (forall a. LoadedModuleG a -> Bool)
-> LoadedModules -> LoadedModules
removeLoadedModule forall a. LoadedModuleG a -> Bool
rm (ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
env) }
loadedModule ::
ModulePath ->
FileInfo ->
NamingEnv ->
Maybe ForeignSrc ->
T.TCTopEntity ->
ModuleM ()
loadedModule :: ModulePath
-> FileInfo
-> NamingEnv
-> Maybe ForeignSrc
-> TCTopEntity
-> ModuleM ()
loadedModule ModulePath
path FileInfo
fi NamingEnv
nameEnv Maybe ForeignSrc
fsrc TCTopEntity
m = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
[Char]
ident <- case ModulePath
path of
InFile [Char]
p -> forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
unModuleT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. BaseM m IO => IO a -> ModuleT m a
io ([Char] -> IO [Char]
canonicalizePath [Char]
p)
InMem [Char]
l ByteString
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
l
let newLM :: LoadedModules -> LoadedModules
newLM =
case TCTopEntity
m of
T.TCTopModule Module
mo -> ModulePath
-> [Char]
-> FileInfo
-> NamingEnv
-> Maybe ForeignSrc
-> Module
-> LoadedModules
-> LoadedModules
addLoadedModule ModulePath
path [Char]
ident FileInfo
fi NamingEnv
nameEnv Maybe ForeignSrc
fsrc Module
mo
T.TCTopSignature ModName
x ModParamNames
s -> ModulePath
-> [Char]
-> FileInfo
-> NamingEnv
-> ModName
-> ModParamNames
-> LoadedModules
-> LoadedModules
addLoadedSignature ModulePath
path [Char]
ident FileInfo
fi NamingEnv
nameEnv ModName
x ModParamNames
s
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meLoadedModules :: LoadedModules
meLoadedModules = LoadedModules -> LoadedModules
newLM (ModuleEnv -> LoadedModules
meLoadedModules ModuleEnv
env) }
modifyEvalEnvM :: Traversable t =>
(EvalEnv -> E.Eval (t EvalEnv)) -> ModuleM (t ())
modifyEvalEnvM :: forall (t :: * -> *).
Traversable t =>
(EvalEnv -> Eval (t EvalEnv)) -> ModuleM (t ())
modifyEvalEnvM EvalEnv -> Eval (t EvalEnv)
f = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
let evalEnv :: EvalEnv
evalEnv = ModuleEnv -> EvalEnv
meEvalEnv ModuleEnv
env
t EvalEnv
tenv <- forall (m :: * -> *) (n :: * -> *) a. BaseM m n => n a -> m a
inBase (forall a. CallStack -> Eval a -> IO a
E.runEval forall a. Monoid a => a
mempty (EvalEnv -> Eval (t EvalEnv)
f EvalEnv
evalEnv))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\EvalEnv
evalEnv' -> forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meEvalEnv :: EvalEnv
meEvalEnv = EvalEnv
evalEnv' }) t EvalEnv
tenv
modifyEvalEnv :: (EvalEnv -> E.Eval EvalEnv) -> ModuleM ()
modifyEvalEnv :: (EvalEnv -> Eval EvalEnv) -> ModuleM ()
modifyEvalEnv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
Traversable t =>
(EvalEnv -> Eval (t EvalEnv)) -> ModuleM (t ())
modifyEvalEnvM forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
getEvalEnv :: ModuleM EvalEnv
getEvalEnv :: ModuleM EvalEnv
getEvalEnv = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (ModuleEnv -> EvalEnv
meEvalEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)
getEvalOptsAction :: ModuleM (IO EvalOpts)
getEvalOptsAction :: ModuleM (IO EvalOpts)
getEvalOptsAction = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (forall (m :: * -> *). RO m -> m EvalOpts
roEvalOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. ReaderM m i => m i
ask)
getEvalOpts :: ModuleM EvalOpts
getEvalOpts :: ModuleM EvalOpts
getEvalOpts =
do IO EvalOpts
act <- ModuleM (IO EvalOpts)
getEvalOptsAction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO EvalOpts
act
getNewtypes :: ModuleM (Map T.Name T.Newtype)
getNewtypes :: ModuleM (Map Name Newtype)
getNewtypes = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (ModuleEnv -> Map Name Newtype
loadedNewtypes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i. StateM m i => m i
get)
getFocusedModule :: ModuleM (Maybe P.ModName)
getFocusedModule :: ModuleM (Maybe ModName)
getFocusedModule = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (ModuleEnv -> Maybe ModName
meFocusedModule forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)
setFocusedModule :: P.ModName -> ModuleM ()
setFocusedModule :: ModName -> ModuleM ()
setFocusedModule ModName
n = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
ModuleEnv
me <- forall (m :: * -> *) i. StateM m i => m i
get
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
me { meFocusedModule :: Maybe ModName
meFocusedModule = forall a. a -> Maybe a
Just ModName
n }
getSearchPath :: ModuleM [FilePath]
getSearchPath :: ModuleM [[Char]]
getSearchPath = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (ModuleEnv -> [[Char]]
meSearchPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)
withPrependedSearchPath :: [FilePath] -> ModuleM a -> ModuleM a
withPrependedSearchPath :: forall a. [[Char]] -> ModuleM a -> ModuleM a
withPrependedSearchPath [[Char]]
fps ModuleM a
m = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
ModuleEnv
env0 <- forall (m :: * -> *) i. StateM m i => m i
get
let fps0 :: [[Char]]
fps0 = ModuleEnv -> [[Char]]
meSearchPath ModuleEnv
env0
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env0 { meSearchPath :: [[Char]]
meSearchPath = [[Char]]
fps forall a. [a] -> [a] -> [a]
++ [[Char]]
fps0 }
a
x <- forall (m :: * -> *) a.
ModuleT m a
-> ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
unModuleT ModuleM a
m
ModuleEnv
env <- forall (m :: * -> *) i. StateM m i => m i
get
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
env { meSearchPath :: [[Char]]
meSearchPath = [[Char]]
fps0 }
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
getFocusedEnv :: ModuleM ModContext
getFocusedEnv :: ModuleM ModContext
getFocusedEnv = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (ModuleEnv -> ModContext
focusedEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)
getDynEnv :: ModuleM DynamicEnv
getDynEnv :: ModuleM DynamicEnv
getDynEnv = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT (ModuleEnv -> DynamicEnv
meDynEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) i. StateM m i => m i
get)
setDynEnv :: DynamicEnv -> ModuleM ()
setDynEnv :: DynamicEnv -> ModuleM ()
setDynEnv DynamicEnv
denv = forall (m :: * -> *) a.
ReaderT
(RO m)
(StateT
ModuleEnv (ExceptionT ModuleError (WriterT [ModuleWarning] m)))
a
-> ModuleT m a
ModuleT forall a b. (a -> b) -> a -> b
$ do
ModuleEnv
me <- forall (m :: * -> *) i. StateM m i => m i
get
forall (m :: * -> *) i. StateM m i => i -> m ()
set forall a b. (a -> b) -> a -> b
$! ModuleEnv
me { meDynEnv :: DynamicEnv
meDynEnv = DynamicEnv
denv }
withLogger :: (Logger -> a -> IO b) -> a -> ModuleM b
withLogger :: forall a b. (Logger -> a -> IO b) -> a -> ModuleM b
withLogger Logger -> a -> IO b
f a
a = do EvalOpts
l <- ModuleM EvalOpts
getEvalOpts
forall (m :: * -> *) a. BaseM m IO => IO a -> ModuleT m a
io (Logger -> a -> IO b
f (EvalOpts -> Logger
evalLogger EvalOpts
l) a
a)