{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Futhark.Compiler.Program
( readLibrary,
readUntypedLibrary,
Imports,
FileModule (..),
E.Warnings,
LoadedProg (lpNameSource),
noLoadedProg,
lpImports,
reloadProg,
extendProg,
)
where
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
( MVar,
modifyMVar,
newEmptyMVar,
newMVar,
putMVar,
readMVar,
)
import Control.Monad
import Control.Monad.Except
import Control.Monad.State (execStateT, gets, modify)
import Data.Bifunctor (first)
import Data.List (intercalate, isPrefixOf, sort)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time.Clock (UTCTime)
import Futhark.Error
import Futhark.FreshNames
import Futhark.Util (interactWithFileSafely, nubOrd, startupTime)
import Futhark.Util.Pretty (line, ppr, text, (</>))
import qualified Language.Futhark as E
import Language.Futhark.Parser
import Language.Futhark.Prelude
import Language.Futhark.Semantic
import qualified Language.Futhark.TypeChecker as E
import Language.Futhark.Warnings
import System.Directory (getModificationTime)
import System.FilePath (normalise)
import qualified System.FilePath.Posix as Posix
data LoadedFile fm = LoadedFile
{ LoadedFile fm -> FilePath
lfPath :: FilePath,
LoadedFile fm -> ImportName
lfImportName :: ImportName,
LoadedFile fm -> fm
lfMod :: fm,
LoadedFile fm -> UTCTime
lfModTime :: UTCTime
}
deriving (LoadedFile fm -> LoadedFile fm -> Bool
(LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool) -> Eq (LoadedFile fm)
forall fm. Eq fm => LoadedFile fm -> LoadedFile fm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoadedFile fm -> LoadedFile fm -> Bool
$c/= :: forall fm. Eq fm => LoadedFile fm -> LoadedFile fm -> Bool
== :: LoadedFile fm -> LoadedFile fm -> Bool
$c== :: forall fm. Eq fm => LoadedFile fm -> LoadedFile fm -> Bool
Eq, Eq (LoadedFile fm)
Eq (LoadedFile fm)
-> (LoadedFile fm -> LoadedFile fm -> Ordering)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> LoadedFile fm)
-> (LoadedFile fm -> LoadedFile fm -> LoadedFile fm)
-> Ord (LoadedFile fm)
LoadedFile fm -> LoadedFile fm -> Bool
LoadedFile fm -> LoadedFile fm -> Ordering
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall fm. Ord fm => Eq (LoadedFile fm)
forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Ordering
forall fm.
Ord fm =>
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
min :: LoadedFile fm -> LoadedFile fm -> LoadedFile fm
$cmin :: forall fm.
Ord fm =>
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
max :: LoadedFile fm -> LoadedFile fm -> LoadedFile fm
$cmax :: forall fm.
Ord fm =>
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
>= :: LoadedFile fm -> LoadedFile fm -> Bool
$c>= :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
> :: LoadedFile fm -> LoadedFile fm -> Bool
$c> :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
<= :: LoadedFile fm -> LoadedFile fm -> Bool
$c<= :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
< :: LoadedFile fm -> LoadedFile fm -> Bool
$c< :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
compare :: LoadedFile fm -> LoadedFile fm -> Ordering
$ccompare :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Ordering
$cp1Ord :: forall fm. Ord fm => Eq (LoadedFile fm)
Ord, Int -> LoadedFile fm -> ShowS
[LoadedFile fm] -> ShowS
LoadedFile fm -> FilePath
(Int -> LoadedFile fm -> ShowS)
-> (LoadedFile fm -> FilePath)
-> ([LoadedFile fm] -> ShowS)
-> Show (LoadedFile fm)
forall fm. Show fm => Int -> LoadedFile fm -> ShowS
forall fm. Show fm => [LoadedFile fm] -> ShowS
forall fm. Show fm => LoadedFile fm -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LoadedFile fm] -> ShowS
$cshowList :: forall fm. Show fm => [LoadedFile fm] -> ShowS
show :: LoadedFile fm -> FilePath
$cshow :: forall fm. Show fm => LoadedFile fm -> FilePath
showsPrec :: Int -> LoadedFile fm -> ShowS
$cshowsPrec :: forall fm. Show fm => Int -> LoadedFile fm -> ShowS
Show)
newtype UncheckedImport = UncheckedImport
{ UncheckedImport
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
unChecked ::
Either CompilerError (LoadedFile E.UncheckedProg, [(ImportName, MVar UncheckedImport)])
}
type ReaderState = MVar (M.Map ImportName (Maybe (MVar UncheckedImport)))
newState :: [ImportName] -> IO ReaderState
newState :: [ImportName] -> IO ReaderState
newState [ImportName]
known = Map ImportName (Maybe (MVar UncheckedImport)) -> IO ReaderState
forall a. a -> IO (MVar a)
newMVar (Map ImportName (Maybe (MVar UncheckedImport)) -> IO ReaderState)
-> Map ImportName (Maybe (MVar UncheckedImport)) -> IO ReaderState
forall a b. (a -> b) -> a -> b
$ [(ImportName, Maybe (MVar UncheckedImport))]
-> Map ImportName (Maybe (MVar UncheckedImport))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ImportName, Maybe (MVar UncheckedImport))]
-> Map ImportName (Maybe (MVar UncheckedImport)))
-> [(ImportName, Maybe (MVar UncheckedImport))]
-> Map ImportName (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ [ImportName]
-> [Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ImportName]
known ([Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))])
-> [Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))]
forall a b. (a -> b) -> a -> b
$ Maybe (MVar UncheckedImport) -> [Maybe (MVar UncheckedImport)]
forall a. a -> [a]
repeat Maybe (MVar UncheckedImport)
forall a. Maybe a
Nothing
orderedImports ::
(MonadError CompilerError m, MonadIO m) =>
[(ImportName, MVar UncheckedImport)] ->
m [(ImportName, LoadedFile E.UncheckedProg)]
orderedImports :: [(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)]
orderedImports = ([(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)])
-> m [(ImportName, LoadedFile UncheckedProg)]
-> m [(ImportName, LoadedFile UncheckedProg)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)]
forall a. [a] -> [a]
reverse (m [(ImportName, LoadedFile UncheckedProg)]
-> m [(ImportName, LoadedFile UncheckedProg)])
-> ([(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)])
-> [(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT [(ImportName, LoadedFile UncheckedProg)] m ()
-> [(ImportName, LoadedFile UncheckedProg)]
-> m [(ImportName, LoadedFile UncheckedProg)])
-> [(ImportName, LoadedFile UncheckedProg)]
-> StateT [(ImportName, LoadedFile UncheckedProg)] m ()
-> m [(ImportName, LoadedFile UncheckedProg)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [(ImportName, LoadedFile UncheckedProg)] m ()
-> [(ImportName, LoadedFile UncheckedProg)]
-> m [(ImportName, LoadedFile UncheckedProg)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT [] (StateT [(ImportName, LoadedFile UncheckedProg)] m ()
-> m [(ImportName, LoadedFile UncheckedProg)])
-> ([(ImportName, MVar UncheckedImport)]
-> StateT [(ImportName, LoadedFile UncheckedProg)] m ())
-> [(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ImportName, MVar UncheckedImport)
-> StateT [(ImportName, LoadedFile UncheckedProg)] m ())
-> [(ImportName, MVar UncheckedImport)]
-> StateT [(ImportName, LoadedFile UncheckedProg)] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ImportName]
-> (ImportName, MVar UncheckedImport)
-> StateT [(ImportName, LoadedFile UncheckedProg)] m ()
forall (m :: * -> *).
(MonadState [(ImportName, LoadedFile UncheckedProg)] m, MonadIO m,
MonadError CompilerError m) =>
[ImportName] -> (ImportName, MVar UncheckedImport) -> m ()
spelunk [])
where
spelunk :: [ImportName] -> (ImportName, MVar UncheckedImport) -> m ()
spelunk [ImportName]
steps (ImportName
include, MVar UncheckedImport
mvar)
| ImportName
include ImportName -> [ImportName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImportName]
steps =
FilePath -> m ()
forall (m :: * -> *) a.
MonadError CompilerError m =>
FilePath -> m a
externalErrorS (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Import cycle: "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate
FilePath
" -> "
((ImportName -> FilePath) -> [ImportName] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ImportName -> FilePath
includeToString ([ImportName] -> [FilePath]) -> [ImportName] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [ImportName] -> [ImportName]
forall a. [a] -> [a]
reverse ([ImportName] -> [ImportName]) -> [ImportName] -> [ImportName]
forall a b. (a -> b) -> a -> b
$ ImportName
include ImportName -> [ImportName] -> [ImportName]
forall a. a -> [a] -> [a]
: [ImportName]
steps)
| Bool
otherwise = do
Maybe (LoadedFile UncheckedProg)
prev <- ([(ImportName, LoadedFile UncheckedProg)]
-> Maybe (LoadedFile UncheckedProg))
-> m (Maybe (LoadedFile UncheckedProg))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (([(ImportName, LoadedFile UncheckedProg)]
-> Maybe (LoadedFile UncheckedProg))
-> m (Maybe (LoadedFile UncheckedProg)))
-> ([(ImportName, LoadedFile UncheckedProg)]
-> Maybe (LoadedFile UncheckedProg))
-> m (Maybe (LoadedFile UncheckedProg))
forall a b. (a -> b) -> a -> b
$ ImportName
-> [(ImportName, LoadedFile UncheckedProg)]
-> Maybe (LoadedFile UncheckedProg)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ImportName
include
case Maybe (LoadedFile UncheckedProg)
prev of
Just LoadedFile UncheckedProg
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe (LoadedFile UncheckedProg)
Nothing -> do
(LoadedFile UncheckedProg
file, [(ImportName, MVar UncheckedImport)]
more_imports) <-
(CompilerError
-> m (LoadedFile UncheckedProg,
[(ImportName, MVar UncheckedImport)]))
-> ((LoadedFile UncheckedProg,
[(ImportName, MVar UncheckedImport)])
-> m (LoadedFile UncheckedProg,
[(ImportName, MVar UncheckedImport)]))
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> m (LoadedFile UncheckedProg,
[(ImportName, MVar UncheckedImport)])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CompilerError
-> m (LoadedFile UncheckedProg,
[(ImportName, MVar UncheckedImport)])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> m (LoadedFile UncheckedProg,
[(ImportName, MVar UncheckedImport)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> m (LoadedFile UncheckedProg,
[(ImportName, MVar UncheckedImport)]))
-> (UncheckedImport
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> UncheckedImport
-> m (LoadedFile UncheckedProg,
[(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UncheckedImport
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
unChecked (UncheckedImport
-> m (LoadedFile UncheckedProg,
[(ImportName, MVar UncheckedImport)]))
-> m UncheckedImport
-> m (LoadedFile UncheckedProg,
[(ImportName, MVar UncheckedImport)])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UncheckedImport -> m UncheckedImport
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar UncheckedImport -> IO UncheckedImport
forall a. MVar a -> IO a
readMVar MVar UncheckedImport
mvar)
((ImportName, MVar UncheckedImport) -> m ())
-> [(ImportName, MVar UncheckedImport)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ImportName] -> (ImportName, MVar UncheckedImport) -> m ()
spelunk (ImportName
include ImportName -> [ImportName] -> [ImportName]
forall a. a -> [a] -> [a]
: [ImportName]
steps)) [(ImportName, MVar UncheckedImport)]
more_imports
([(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, LoadedFile UncheckedProg
file) (ImportName, LoadedFile UncheckedProg)
-> [(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)]
forall a. a -> [a] -> [a]
:)
newImportMVar :: IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar :: IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar IO UncheckedImport
m = do
MVar UncheckedImport
mvar <- IO (MVar UncheckedImport)
forall a. IO (MVar a)
newEmptyMVar
IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ MVar UncheckedImport -> UncheckedImport -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar UncheckedImport
mvar (UncheckedImport -> IO ()) -> IO UncheckedImport -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UncheckedImport
m
Maybe (MVar UncheckedImport) -> IO (Maybe (MVar UncheckedImport))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (MVar UncheckedImport) -> IO (Maybe (MVar UncheckedImport)))
-> Maybe (MVar UncheckedImport)
-> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ MVar UncheckedImport -> Maybe (MVar UncheckedImport)
forall a. a -> Maybe a
Just MVar UncheckedImport
mvar
contentsAndModTime :: FilePath -> IO (Maybe (Either String (T.Text, UTCTime)))
contentsAndModTime :: FilePath -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
filepath =
IO (Text, UTCTime) -> IO (Maybe (Either FilePath (Text, UTCTime)))
forall a. IO a -> IO (Maybe (Either FilePath a))
interactWithFileSafely (IO (Text, UTCTime)
-> IO (Maybe (Either FilePath (Text, UTCTime))))
-> IO (Text, UTCTime)
-> IO (Maybe (Either FilePath (Text, UTCTime)))
forall a b. (a -> b) -> a -> b
$
(,) (Text -> UTCTime -> (Text, UTCTime))
-> IO Text -> IO (UTCTime -> (Text, UTCTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
T.readFile FilePath
filepath IO (UTCTime -> (Text, UTCTime)) -> IO UTCTime -> IO (Text, UTCTime)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO UTCTime
getModificationTime FilePath
filepath
readImportFile :: ImportName -> IO (Either CompilerError (LoadedFile T.Text))
readImportFile :: ImportName -> IO (Either CompilerError (LoadedFile Text))
readImportFile ImportName
include = do
let filepath :: FilePath
filepath = ImportName -> FilePath
includeToFilePath ImportName
include
Maybe (Either FilePath (Text, UTCTime))
r <- FilePath -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
filepath
case (Maybe (Either FilePath (Text, UTCTime))
r, FilePath -> [(FilePath, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
prelude_str [(FilePath, Text)]
prelude) of
(Just (Right (Text
s, UTCTime
mod_time)), Maybe Text
_) ->
Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text)))
-> Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ LoadedFile Text -> Either CompilerError (LoadedFile Text)
forall a b. b -> Either a b
Right (LoadedFile Text -> Either CompilerError (LoadedFile Text))
-> LoadedFile Text -> Either CompilerError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> UTCTime -> LoadedFile Text
forall fm. FilePath -> fm -> UTCTime -> LoadedFile fm
loaded FilePath
filepath Text
s UTCTime
mod_time
(Just (Left FilePath
e), Maybe Text
_) -> Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text)))
-> Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ CompilerError -> Either CompilerError (LoadedFile Text)
forall a b. a -> Either a b
Left (CompilerError -> Either CompilerError (LoadedFile Text))
-> CompilerError -> Either CompilerError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ Doc -> CompilerError
ExternalError (Doc -> CompilerError) -> Doc -> CompilerError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
e
(Maybe (Either FilePath (Text, UTCTime))
Nothing, Just Text
s) ->
Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text)))
-> Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ LoadedFile Text -> Either CompilerError (LoadedFile Text)
forall a b. b -> Either a b
Right (LoadedFile Text -> Either CompilerError (LoadedFile Text))
-> LoadedFile Text -> Either CompilerError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> UTCTime -> LoadedFile Text
forall fm. FilePath -> fm -> UTCTime -> LoadedFile fm
loaded FilePath
prelude_str Text
s UTCTime
startupTime
(Maybe (Either FilePath (Text, UTCTime))
Nothing, Maybe Text
Nothing) -> Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text)))
-> Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ CompilerError -> Either CompilerError (LoadedFile Text)
forall a b. a -> Either a b
Left (CompilerError -> Either CompilerError (LoadedFile Text))
-> CompilerError -> Either CompilerError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ Doc -> CompilerError
ExternalError (Doc -> CompilerError) -> Doc -> CompilerError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
not_found
where
prelude_str :: FilePath
prelude_str = FilePath
"/" FilePath -> ShowS
Posix.</> ImportName -> FilePath
includeToString ImportName
include FilePath -> ShowS
Posix.<.> FilePath
"fut"
loaded :: FilePath -> fm -> UTCTime -> LoadedFile fm
loaded FilePath
path fm
s UTCTime
mod_time =
LoadedFile :: forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile
{ lfImportName :: ImportName
lfImportName = ImportName
include,
lfPath :: FilePath
lfPath = FilePath
path,
lfMod :: fm
lfMod = fm
s,
lfModTime :: UTCTime
lfModTime = UTCTime
mod_time
}
not_found :: FilePath
not_found =
FilePath
"Error at " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> FilePath
forall a. Located a => a -> FilePath
E.locStr (ImportName -> SrcLoc
forall a. Located a => a -> SrcLoc
E.srclocOf ImportName
include)
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": could not find import '"
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ImportName -> FilePath
includeToString ImportName
include
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'."
handleFile ::
ReaderState -> LoadedFile T.Text -> IO UncheckedImport
handleFile :: ReaderState -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar (LoadedFile FilePath
file_name ImportName
import_name Text
file_contents UTCTime
mod_time) = do
case FilePath -> Text -> Either ParseError UncheckedProg
parseFuthark FilePath
file_name Text
file_contents of
Left ParseError
err -> UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> UncheckedImport -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport)
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ CompilerError
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (CompilerError
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> CompilerError
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. (a -> b) -> a -> b
$ Doc -> CompilerError
ExternalError (Doc -> CompilerError) -> Doc -> CompilerError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err
Right UncheckedProg
prog -> do
let imports :: [ImportName]
imports = ((FilePath, SrcLoc) -> ImportName)
-> [(FilePath, SrcLoc)] -> [ImportName]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> SrcLoc -> ImportName)
-> (FilePath, SrcLoc) -> ImportName
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ImportName -> FilePath -> SrcLoc -> ImportName
mkImportFrom ImportName
import_name)) ([(FilePath, SrcLoc)] -> [ImportName])
-> [(FilePath, SrcLoc)] -> [ImportName]
forall a b. (a -> b) -> a -> b
$ UncheckedProg -> [(FilePath, SrcLoc)]
forall (f :: * -> *) vn. ProgBase f vn -> [(FilePath, SrcLoc)]
E.progImports UncheckedProg
prog
[(ImportName, MVar UncheckedImport)]
mvars <-
((ImportName, Maybe (MVar UncheckedImport))
-> Maybe (ImportName, MVar UncheckedImport))
-> [(ImportName, Maybe (MVar UncheckedImport))]
-> [(ImportName, MVar UncheckedImport)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportName, Maybe (MVar UncheckedImport))
-> Maybe (ImportName, MVar UncheckedImport)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([(ImportName, Maybe (MVar UncheckedImport))]
-> [(ImportName, MVar UncheckedImport)])
-> ([Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))])
-> [Maybe (MVar UncheckedImport)]
-> [(ImportName, MVar UncheckedImport)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportName]
-> [Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ImportName]
imports
([Maybe (MVar UncheckedImport)]
-> [(ImportName, MVar UncheckedImport)])
-> IO [Maybe (MVar UncheckedImport)]
-> IO [(ImportName, MVar UncheckedImport)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImportName -> IO (Maybe (MVar UncheckedImport)))
-> [ImportName] -> IO [Maybe (MVar UncheckedImport)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar) [ImportName]
imports
let file :: LoadedFile UncheckedProg
file =
LoadedFile :: forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile
{ lfPath :: FilePath
lfPath = FilePath
file_name,
lfImportName :: ImportName
lfImportName = ImportName
import_name,
lfModTime :: UTCTime
lfModTime = UTCTime
mod_time,
lfMod :: UncheckedProg
lfMod = UncheckedProg
prog
}
UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> UncheckedImport -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport)
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. b -> Either a b
Right (LoadedFile UncheckedProg
file, [(ImportName, MVar UncheckedImport)]
mvars)
readImport :: ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport :: ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar ImportName
include =
ReaderState
-> (Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar ReaderState
state_mvar ((Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport)))
-> (Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ \Map ImportName (Maybe (MVar UncheckedImport))
state ->
case ImportName
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Maybe (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ImportName
include Map ImportName (Maybe (MVar UncheckedImport))
state of
Just Maybe (MVar UncheckedImport)
x -> (Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ImportName (Maybe (MVar UncheckedImport))
state, Maybe (MVar UncheckedImport)
x)
Maybe (Maybe (MVar UncheckedImport))
Nothing -> do
Maybe (MVar UncheckedImport)
prog_mvar <- IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar (IO UncheckedImport -> IO (Maybe (MVar UncheckedImport)))
-> IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ do
ImportName -> IO (Either CompilerError (LoadedFile Text))
readImportFile ImportName
include IO (Either CompilerError (LoadedFile Text))
-> (Either CompilerError (LoadedFile Text) -> IO UncheckedImport)
-> IO UncheckedImport
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left CompilerError
e -> UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> UncheckedImport -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport)
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ CompilerError
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left CompilerError
e
Right LoadedFile Text
file -> ReaderState -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar LoadedFile Text
file
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImportName
-> Maybe (MVar UncheckedImport)
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Map ImportName (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ImportName
include Maybe (MVar UncheckedImport)
prog_mvar Map ImportName (Maybe (MVar UncheckedImport))
state, Maybe (MVar UncheckedImport)
prog_mvar)
readUntypedLibraryExceptKnown ::
(MonadIO m, MonadError CompilerError m) =>
[ImportName] ->
[FilePath] ->
m [LoadedFile E.UncheckedProg]
readUntypedLibraryExceptKnown :: [ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
readUntypedLibraryExceptKnown [ImportName]
known [FilePath]
fps = do
ReaderState
state_mvar <- IO ReaderState -> m ReaderState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReaderState -> m ReaderState)
-> IO ReaderState -> m ReaderState
forall a b. (a -> b) -> a -> b
$ [ImportName] -> IO ReaderState
newState [ImportName]
known
let prelude_import :: ImportName
prelude_import = FilePath -> ImportName
mkInitialImport FilePath
"/prelude/prelude"
Maybe (MVar UncheckedImport)
prelude_mvar <- IO (Maybe (MVar UncheckedImport))
-> m (Maybe (MVar UncheckedImport))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (MVar UncheckedImport))
-> m (Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport))
-> m (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar ImportName
prelude_import
[(ImportName, Maybe (MVar UncheckedImport))]
fps_mvars <- IO [(ImportName, Maybe (MVar UncheckedImport))]
-> m [(ImportName, Maybe (MVar UncheckedImport))]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> IO (ImportName, Maybe (MVar UncheckedImport)))
-> [FilePath] -> IO [(ImportName, Maybe (MVar UncheckedImport))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ReaderState
-> FilePath -> IO (ImportName, Maybe (MVar UncheckedImport))
onFile ReaderState
state_mvar) [FilePath]
fps)
let unknown_mvars :: [(ImportName, MVar UncheckedImport)]
unknown_mvars = [(ImportName, Maybe (MVar UncheckedImport))]
-> [(ImportName, MVar UncheckedImport)]
forall a. [(ImportName, Maybe a)] -> [(ImportName, a)]
onlyUnknown ((ImportName
prelude_import, Maybe (MVar UncheckedImport)
prelude_mvar) (ImportName, Maybe (MVar UncheckedImport))
-> [(ImportName, Maybe (MVar UncheckedImport))]
-> [(ImportName, Maybe (MVar UncheckedImport))]
forall a. a -> [a] -> [a]
: [(ImportName, Maybe (MVar UncheckedImport))]
fps_mvars)
((ImportName, LoadedFile UncheckedProg)
-> LoadedFile UncheckedProg)
-> [(ImportName, LoadedFile UncheckedProg)]
-> [LoadedFile UncheckedProg]
forall a b. (a -> b) -> [a] -> [b]
map (ImportName, LoadedFile UncheckedProg) -> LoadedFile UncheckedProg
forall a b. (a, b) -> b
snd ([(ImportName, LoadedFile UncheckedProg)]
-> [LoadedFile UncheckedProg])
-> m [(ImportName, LoadedFile UncheckedProg)]
-> m [LoadedFile UncheckedProg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)]
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)]
orderedImports [(ImportName, MVar UncheckedImport)]
unknown_mvars
where
onlyUnknown :: [(ImportName, Maybe a)] -> [(ImportName, a)]
onlyUnknown = ((ImportName, Maybe a) -> Maybe (ImportName, a))
-> [(ImportName, Maybe a)] -> [(ImportName, a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportName, Maybe a) -> Maybe (ImportName, a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
onFile :: ReaderState
-> FilePath -> IO (ImportName, Maybe (MVar UncheckedImport))
onFile ReaderState
state_mvar FilePath
fp =
ReaderState
-> (Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport))))
-> IO (ImportName, Maybe (MVar UncheckedImport))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar ReaderState
state_mvar ((Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport))))
-> IO (ImportName, Maybe (MVar UncheckedImport)))
-> (Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport))))
-> IO (ImportName, Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ \Map ImportName (Maybe (MVar UncheckedImport))
state -> do
case ImportName
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Maybe (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ImportName
include Map ImportName (Maybe (MVar UncheckedImport))
state of
Just Maybe (MVar UncheckedImport)
prog_mvar -> (Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport)))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ImportName (Maybe (MVar UncheckedImport))
state, (ImportName
include, Maybe (MVar UncheckedImport)
prog_mvar))
Maybe (Maybe (MVar UncheckedImport))
Nothing -> do
Maybe (MVar UncheckedImport)
prog_mvar <- IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar (IO UncheckedImport -> IO (Maybe (MVar UncheckedImport)))
-> IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ do
Maybe (Either FilePath (Text, UTCTime))
r <- FilePath -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
fp
case Maybe (Either FilePath (Text, UTCTime))
r of
Just (Right (Text
fs, UTCTime
mod_time)) -> do
ReaderState -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar (LoadedFile Text -> IO UncheckedImport)
-> LoadedFile Text -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$
LoadedFile :: forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile
{ lfImportName :: ImportName
lfImportName = ImportName
include,
lfMod :: Text
lfMod = Text
fs,
lfModTime :: UTCTime
lfModTime = UTCTime
mod_time,
lfPath :: FilePath
lfPath = FilePath
fp
}
Just (Left FilePath
e) ->
UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> UncheckedImport -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport)
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ CompilerError
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (CompilerError
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> CompilerError
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. (a -> b) -> a -> b
$ Doc -> CompilerError
ExternalError (Doc -> CompilerError) -> Doc -> CompilerError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> FilePath
show FilePath
e
Maybe (Either FilePath (Text, UTCTime))
Nothing ->
UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> UncheckedImport -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport)
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ CompilerError
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (CompilerError
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> CompilerError
-> Either
CompilerError
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. (a -> b) -> a -> b
$ Doc -> CompilerError
ExternalError (Doc -> CompilerError) -> Doc -> CompilerError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ FilePath
fp FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
": file not found."
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport)))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImportName
-> Maybe (MVar UncheckedImport)
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Map ImportName (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ImportName
include Maybe (MVar UncheckedImport)
prog_mvar Map ImportName (Maybe (MVar UncheckedImport))
state, (ImportName
include, Maybe (MVar UncheckedImport)
prog_mvar))
where
include :: ImportName
include = FilePath -> ImportName
mkInitialImport FilePath
fp_name
(FilePath
fp_name, FilePath
_) = FilePath -> (FilePath, FilePath)
Posix.splitExtension FilePath
fp
asImports :: [LoadedFile (VNameSource, FileModule)] -> Imports
asImports :: [LoadedFile (VNameSource, FileModule)] -> Imports
asImports = (LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule))
-> [LoadedFile (VNameSource, FileModule)] -> Imports
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule)
forall a b. LoadedFile (a, b) -> (FilePath, b)
f
where
f :: LoadedFile (a, b) -> (FilePath, b)
f LoadedFile (a, b)
lf = (ImportName -> FilePath
includeToString (LoadedFile (a, b) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile (a, b)
lf), (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> (a, b) -> b
forall a b. (a -> b) -> a -> b
$ LoadedFile (a, b) -> (a, b)
forall fm. LoadedFile fm -> fm
lfMod LoadedFile (a, b)
lf)
typeCheckProg ::
MonadError CompilerError m =>
[LoadedFile (VNameSource, FileModule)] ->
VNameSource ->
[LoadedFile E.UncheckedProg] ->
m (E.Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
typeCheckProg :: [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
typeCheckProg [LoadedFile (VNameSource, FileModule)]
orig_imports VNameSource
orig_src =
((Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> LoadedFile UncheckedProg
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource))
-> (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> LoadedFile UncheckedProg
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
forall (m :: * -> *).
MonadError CompilerError m =>
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> LoadedFile UncheckedProg
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
f (Warnings
forall a. Monoid a => a
mempty, [LoadedFile (VNameSource, FileModule)]
orig_imports, VNameSource
orig_src)
where
roots :: [FilePath]
roots = [FilePath
"/prelude/prelude"]
f :: (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> LoadedFile UncheckedProg
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
f (Warnings
ws, [LoadedFile (VNameSource, FileModule)]
imports, VNameSource
src) (LoadedFile FilePath
path ImportName
import_name UncheckedProg
prog UTCTime
mod_time) = do
let prog' :: UncheckedProg
prog'
| FilePath
"/prelude" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ImportName -> FilePath
includeToFilePath ImportName
import_name = UncheckedProg
prog
| Bool
otherwise = [FilePath] -> UncheckedProg -> UncheckedProg
prependRoots [FilePath]
roots UncheckedProg
prog
case Imports
-> VNameSource
-> ImportName
-> UncheckedProg
-> (Warnings, Either TypeError (FileModule, VNameSource))
E.checkProg ([LoadedFile (VNameSource, FileModule)] -> Imports
asImports [LoadedFile (VNameSource, FileModule)]
imports) VNameSource
src ImportName
import_name UncheckedProg
prog' of
(Warnings
prog_ws, Left TypeError
err) -> do
let ws' :: Warnings
ws' = Warnings
ws Warnings -> Warnings -> Warnings
forall a. Semigroup a => a -> a -> a
<> Warnings
prog_ws
Doc
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
forall (m :: * -> *) a. MonadError CompilerError m => Doc -> m a
externalError (Doc
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource))
-> Doc
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
forall a b. (a -> b) -> a -> b
$
if Warnings -> Bool
anyWarnings Warnings
ws'
then Warnings -> Doc
forall a. Pretty a => a -> Doc
ppr Warnings
ws' Doc -> Doc -> Doc
</> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> TypeError -> Doc
forall a. Pretty a => a -> Doc
ppr TypeError
err
else TypeError -> Doc
forall a. Pretty a => a -> Doc
ppr TypeError
err
(Warnings
prog_ws, Right (FileModule
m, VNameSource
src')) ->
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Warnings
ws Warnings -> Warnings -> Warnings
forall a. Semigroup a => a -> a -> a
<> Warnings
prog_ws,
[LoadedFile (VNameSource, FileModule)]
imports [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
forall a. [a] -> [a] -> [a]
++ [FilePath
-> ImportName
-> (VNameSource, FileModule)
-> UTCTime
-> LoadedFile (VNameSource, FileModule)
forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile FilePath
path ImportName
import_name (VNameSource
src, FileModule
m) UTCTime
mod_time],
VNameSource
src'
)
setEntryPoints ::
[E.Name] ->
[FilePath] ->
[LoadedFile E.UncheckedProg] ->
[LoadedFile E.UncheckedProg]
setEntryPoints :: [Name]
-> [FilePath]
-> [LoadedFile UncheckedProg]
-> [LoadedFile UncheckedProg]
setEntryPoints [Name]
extra_eps [FilePath]
fps = (LoadedFile UncheckedProg -> LoadedFile UncheckedProg)
-> [LoadedFile UncheckedProg] -> [LoadedFile UncheckedProg]
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile UncheckedProg -> LoadedFile UncheckedProg
onFile
where
fps' :: [FilePath]
fps' = ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
normalise [FilePath]
fps
onFile :: LoadedFile UncheckedProg -> LoadedFile UncheckedProg
onFile LoadedFile UncheckedProg
lf
| ImportName -> FilePath
includeToFilePath (LoadedFile UncheckedProg -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile UncheckedProg
lf) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
fps' =
LoadedFile UncheckedProg
lf {lfMod :: UncheckedProg
lfMod = UncheckedProg
prog {progDecs :: [DecBase NoInfo Name]
E.progDecs = (DecBase NoInfo Name -> DecBase NoInfo Name)
-> [DecBase NoInfo Name] -> [DecBase NoInfo Name]
forall a b. (a -> b) -> [a] -> [b]
map DecBase NoInfo Name -> DecBase NoInfo Name
onDec (UncheckedProg -> [DecBase NoInfo Name]
forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
E.progDecs UncheckedProg
prog)}}
| Bool
otherwise =
LoadedFile UncheckedProg
lf
where
prog :: UncheckedProg
prog = LoadedFile UncheckedProg -> UncheckedProg
forall fm. LoadedFile fm -> fm
lfMod LoadedFile UncheckedProg
lf
onDec :: DecBase NoInfo Name -> DecBase NoInfo Name
onDec (E.ValDec ValBindBase NoInfo Name
vb)
| ValBindBase NoInfo Name -> Name
forall (f :: * -> *) vn. ValBindBase f vn -> vn
E.valBindName ValBindBase NoInfo Name
vb Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
extra_eps =
ValBindBase NoInfo Name -> DecBase NoInfo Name
forall (f :: * -> *) vn. ValBindBase f vn -> DecBase f vn
E.ValDec ValBindBase NoInfo Name
vb {valBindEntryPoint :: Maybe (NoInfo EntryPoint)
E.valBindEntryPoint = NoInfo EntryPoint -> Maybe (NoInfo EntryPoint)
forall a. a -> Maybe a
Just NoInfo EntryPoint
forall a. NoInfo a
E.NoInfo}
onDec DecBase NoInfo Name
dec = DecBase NoInfo Name
dec
prependRoots :: [FilePath] -> E.UncheckedProg -> E.UncheckedProg
prependRoots :: [FilePath] -> UncheckedProg -> UncheckedProg
prependRoots [FilePath]
roots (E.Prog Maybe DocComment
doc [DecBase NoInfo Name]
ds) =
Maybe DocComment -> [DecBase NoInfo Name] -> UncheckedProg
forall (f :: * -> *) vn.
Maybe DocComment -> [DecBase f vn] -> ProgBase f vn
E.Prog Maybe DocComment
doc ([DecBase NoInfo Name] -> UncheckedProg)
-> [DecBase NoInfo Name] -> UncheckedProg
forall a b. (a -> b) -> a -> b
$ (FilePath -> DecBase NoInfo Name)
-> [FilePath] -> [DecBase NoInfo Name]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> DecBase NoInfo Name
forall vn. FilePath -> DecBase NoInfo vn
mkImport [FilePath]
roots [DecBase NoInfo Name]
-> [DecBase NoInfo Name] -> [DecBase NoInfo Name]
forall a. [a] -> [a] -> [a]
++ [DecBase NoInfo Name]
ds
where
mkImport :: FilePath -> DecBase NoInfo vn
mkImport FilePath
fp =
DecBase NoInfo vn -> SrcLoc -> DecBase NoInfo vn
forall (f :: * -> *) vn. DecBase f vn -> SrcLoc -> DecBase f vn
E.LocalDec (ModExpBase NoInfo vn -> SrcLoc -> DecBase NoInfo vn
forall (f :: * -> *) vn. ModExpBase f vn -> SrcLoc -> DecBase f vn
E.OpenDec (FilePath -> NoInfo FilePath -> SrcLoc -> ModExpBase NoInfo vn
forall (f :: * -> *) vn.
FilePath -> f FilePath -> SrcLoc -> ModExpBase f vn
E.ModImport FilePath
fp NoInfo FilePath
forall a. NoInfo a
E.NoInfo SrcLoc
forall a. Monoid a => a
mempty) SrcLoc
forall a. Monoid a => a
mempty) SrcLoc
forall a. Monoid a => a
mempty
data LoadedProg = LoadedProg
{ LoadedProg -> [FilePath]
lpRoots :: [FilePath],
LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles :: [LoadedFile (VNameSource, FileModule)],
LoadedProg -> VNameSource
lpNameSource :: VNameSource
}
lpImports :: LoadedProg -> Imports
lpImports :: LoadedProg -> Imports
lpImports = (LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule))
-> [LoadedFile (VNameSource, FileModule)] -> Imports
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule)
forall a b. LoadedFile (a, b) -> (FilePath, b)
f ([LoadedFile (VNameSource, FileModule)] -> Imports)
-> (LoadedProg -> [LoadedFile (VNameSource, FileModule)])
-> LoadedProg
-> Imports
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles
where
f :: LoadedFile (a, b) -> (FilePath, b)
f LoadedFile (a, b)
lf = (ImportName -> FilePath
includeToString (LoadedFile (a, b) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile (a, b)
lf), (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> (a, b) -> b
forall a b. (a -> b) -> a -> b
$ LoadedFile (a, b) -> (a, b)
forall fm. LoadedFile fm -> fm
lfMod LoadedFile (a, b)
lf)
unchangedImports ::
MonadIO m =>
VNameSource ->
[LoadedFile (VNameSource, FileModule)] ->
m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports :: VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [] = ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], VNameSource
src)
unchangedImports VNameSource
src (LoadedFile (VNameSource, FileModule)
f : [LoadedFile (VNameSource, FileModule)]
fs)
| FilePath
"/prelude" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ImportName -> FilePath
includeToFilePath (LoadedFile (VNameSource, FileModule) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile (VNameSource, FileModule)
f) =
([LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)])
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (LoadedFile (VNameSource, FileModule)
f LoadedFile (VNameSource, FileModule)
-> [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
forall a. a -> [a] -> [a]
:) (([LoadedFile (VNameSource, FileModule)], VNameSource)
-> ([LoadedFile (VNameSource, FileModule)], VNameSource))
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [LoadedFile (VNameSource, FileModule)]
fs
| Bool
otherwise = do
Bool
changed <-
Bool
-> (Either FilePath UTCTime -> Bool)
-> Maybe (Either FilePath UTCTime)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((FilePath -> Bool)
-> (UTCTime -> Bool) -> Either FilePath UTCTime -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> FilePath -> Bool
forall a b. a -> b -> a
const Bool
True) (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> LoadedFile (VNameSource, FileModule) -> UTCTime
forall fm. LoadedFile fm -> UTCTime
lfModTime LoadedFile (VNameSource, FileModule)
f))
(Maybe (Either FilePath UTCTime) -> Bool)
-> m (Maybe (Either FilePath UTCTime)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Either FilePath UTCTime))
-> m (Maybe (Either FilePath UTCTime))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> IO (Maybe (Either FilePath UTCTime))
forall a. IO a -> IO (Maybe (Either FilePath a))
interactWithFileSafely (FilePath -> IO UTCTime
getModificationTime (FilePath -> IO UTCTime) -> FilePath -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ LoadedFile (VNameSource, FileModule) -> FilePath
forall fm. LoadedFile fm -> FilePath
lfPath LoadedFile (VNameSource, FileModule)
f))
if Bool
changed
then ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], (VNameSource, FileModule) -> VNameSource
forall a b. (a, b) -> a
fst ((VNameSource, FileModule) -> VNameSource)
-> (VNameSource, FileModule) -> VNameSource
forall a b. (a -> b) -> a -> b
$ LoadedFile (VNameSource, FileModule) -> (VNameSource, FileModule)
forall fm. LoadedFile fm -> fm
lfMod LoadedFile (VNameSource, FileModule)
f)
else ([LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)])
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (LoadedFile (VNameSource, FileModule)
f LoadedFile (VNameSource, FileModule)
-> [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
forall a. a -> [a] -> [a]
:) (([LoadedFile (VNameSource, FileModule)], VNameSource)
-> ([LoadedFile (VNameSource, FileModule)], VNameSource))
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [LoadedFile (VNameSource, FileModule)]
fs
noLoadedProg :: LoadedProg
noLoadedProg :: LoadedProg
noLoadedProg =
LoadedProg :: [FilePath]
-> [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> LoadedProg
LoadedProg
{ lpRoots :: [FilePath]
lpRoots = [],
lpFiles :: [LoadedFile (VNameSource, FileModule)]
lpFiles = [LoadedFile (VNameSource, FileModule)]
forall a. Monoid a => a
mempty,
lpNameSource :: VNameSource
lpNameSource = Int -> VNameSource
newNameSource (Int -> VNameSource) -> Int -> VNameSource
forall a b. (a -> b) -> a -> b
$ Int
E.maxIntrinsicTag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
}
usableLoadedProg :: MonadIO m => LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg :: LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg (LoadedProg [FilePath]
roots [LoadedFile (VNameSource, FileModule)]
imports VNameSource
src) [FilePath]
new_roots
| [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
roots [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
new_roots = do
([LoadedFile (VNameSource, FileModule)]
imports', VNameSource
src') <- VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [LoadedFile (VNameSource, FileModule)]
imports
LoadedProg -> m LoadedProg
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoadedProg -> m LoadedProg) -> LoadedProg -> m LoadedProg
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> LoadedProg
LoadedProg [] [LoadedFile (VNameSource, FileModule)]
imports' VNameSource
src'
| Bool
otherwise =
LoadedProg -> m LoadedProg
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoadedProg
noLoadedProg
extendProg ::
(MonadError CompilerError m, MonadIO m) =>
LoadedProg ->
[FilePath] ->
m (E.Warnings, LoadedProg)
extendProg :: LoadedProg -> [FilePath] -> m (Warnings, LoadedProg)
extendProg LoadedProg
lp [FilePath]
new_roots = do
[LoadedFile UncheckedProg]
new_imports_untyped <-
[ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
readUntypedLibraryExceptKnown ((LoadedFile (VNameSource, FileModule) -> ImportName)
-> [LoadedFile (VNameSource, FileModule)] -> [ImportName]
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile (VNameSource, FileModule) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName ([LoadedFile (VNameSource, FileModule)] -> [ImportName])
-> [LoadedFile (VNameSource, FileModule)] -> [ImportName]
forall a b. (a -> b) -> a -> b
$ LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles LoadedProg
lp) [FilePath]
new_roots
(Warnings
ws, [LoadedFile (VNameSource, FileModule)]
imports, VNameSource
src') <-
[LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
forall (m :: * -> *).
MonadError CompilerError m =>
[LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
typeCheckProg (LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles LoadedProg
lp) (LoadedProg -> VNameSource
lpNameSource LoadedProg
lp) [LoadedFile UncheckedProg]
new_imports_untyped
(Warnings, LoadedProg) -> m (Warnings, LoadedProg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Warnings
ws, [FilePath]
-> [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> LoadedProg
LoadedProg ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd (LoadedProg -> [FilePath]
lpRoots LoadedProg
lp [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
new_roots)) [LoadedFile (VNameSource, FileModule)]
imports VNameSource
src')
reloadProg ::
(MonadError CompilerError m, MonadIO m) =>
LoadedProg ->
[FilePath] ->
m (E.Warnings, LoadedProg)
reloadProg :: LoadedProg -> [FilePath] -> m (Warnings, LoadedProg)
reloadProg LoadedProg
lp [FilePath]
new_roots = do
LoadedProg
lp' <- LoadedProg -> [FilePath] -> m LoadedProg
forall (m :: * -> *).
MonadIO m =>
LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg LoadedProg
lp [FilePath]
new_roots
LoadedProg -> [FilePath] -> m (Warnings, LoadedProg)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
LoadedProg -> [FilePath] -> m (Warnings, LoadedProg)
extendProg LoadedProg
lp' [FilePath]
new_roots
readLibrary ::
(MonadError CompilerError m, MonadIO m) =>
[E.Name] ->
[FilePath] ->
m (E.Warnings, Imports, VNameSource)
readLibrary :: [Name] -> [FilePath] -> m (Warnings, Imports, VNameSource)
readLibrary [Name]
extra_eps [FilePath]
fps =
((Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> (Warnings, Imports, VNameSource))
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
-> m (Warnings, Imports, VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> (Warnings, Imports, VNameSource)
forall a c.
(a, [LoadedFile (VNameSource, FileModule)], c) -> (a, Imports, c)
frob
(m (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> m (Warnings, Imports, VNameSource))
-> ([LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource))
-> [LoadedFile UncheckedProg]
-> m (Warnings, Imports, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
forall (m :: * -> *).
MonadError CompilerError m =>
[LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
typeCheckProg [LoadedFile (VNameSource, FileModule)]
forall a. Monoid a => a
mempty (LoadedProg -> VNameSource
lpNameSource LoadedProg
noLoadedProg)
([LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource))
-> ([LoadedFile UncheckedProg] -> [LoadedFile UncheckedProg])
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name]
-> [FilePath]
-> [LoadedFile UncheckedProg]
-> [LoadedFile UncheckedProg]
setEntryPoints (Name
E.defaultEntryPoint Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
extra_eps) [FilePath]
fps
([LoadedFile UncheckedProg] -> m (Warnings, Imports, VNameSource))
-> m [LoadedFile UncheckedProg]
-> m (Warnings, Imports, VNameSource)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
readUntypedLibraryExceptKnown [] [FilePath]
fps
where
frob :: (a, [LoadedFile (VNameSource, FileModule)], c) -> (a, Imports, c)
frob (a
x, [LoadedFile (VNameSource, FileModule)]
y, c
z) = (a
x, [LoadedFile (VNameSource, FileModule)] -> Imports
asImports [LoadedFile (VNameSource, FileModule)]
y, c
z)
readUntypedLibrary ::
(MonadIO m, MonadError CompilerError m) =>
[FilePath] ->
m [(ImportName, E.UncheckedProg)]
readUntypedLibrary :: [FilePath] -> m [(ImportName, UncheckedProg)]
readUntypedLibrary = ([LoadedFile UncheckedProg] -> [(ImportName, UncheckedProg)])
-> m [LoadedFile UncheckedProg] -> m [(ImportName, UncheckedProg)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LoadedFile UncheckedProg -> (ImportName, UncheckedProg))
-> [LoadedFile UncheckedProg] -> [(ImportName, UncheckedProg)]
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile UncheckedProg -> (ImportName, UncheckedProg)
forall b. LoadedFile b -> (ImportName, b)
f) (m [LoadedFile UncheckedProg] -> m [(ImportName, UncheckedProg)])
-> ([FilePath] -> m [LoadedFile UncheckedProg])
-> [FilePath]
-> m [(ImportName, UncheckedProg)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
readUntypedLibraryExceptKnown []
where
f :: LoadedFile b -> (ImportName, b)
f LoadedFile b
lf = (LoadedFile b -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile b
lf, LoadedFile b -> b
forall fm. LoadedFile fm -> fm
lfMod LoadedFile b
lf)