{-# LANGUAGE LambdaCase #-}
module Futhark.Compiler.Program
( readLibrary,
readUntypedLibrary,
Imports,
FileModule (..),
E.Warnings,
prettyWarnings,
ProgError (..),
LoadedProg (lpNameSource),
noLoadedProg,
lpImports,
lpWarnings,
lpFilePaths,
reloadProg,
extendProg,
VFS,
)
where
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
( MVar,
modifyMVar,
newEmptyMVar,
newMVar,
putMVar,
readMVar,
)
import Control.Monad
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.State (execStateT, gets, modify)
import Data.Bifunctor (first)
import Data.List (intercalate, sort)
import Data.List.NonEmpty qualified as NE
import Data.Loc (Loc (..), Located, locOf)
import Data.Map qualified as M
import Data.Maybe (mapMaybe)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Time.Clock (UTCTime, getCurrentTime)
import Futhark.FreshNames
import Futhark.Util (interactWithFileSafely, nubOrd, startupTime)
import Futhark.Util.Pretty (Doc, align, pretty)
import Language.Futhark qualified as E
import Language.Futhark.Parser (SyntaxError (..), parseFuthark)
import Language.Futhark.Prelude
import Language.Futhark.Prop (isBuiltin)
import Language.Futhark.Semantic
import Language.Futhark.TypeChecker qualified as E
import Language.Futhark.Warnings
import System.Directory (getModificationTime)
import System.FilePath (normalise, takeExtension)
import System.FilePath.Posix qualified as Posix
data LoadedFile fm = LoadedFile
{ forall fm. LoadedFile fm -> FilePath
lfPath :: FilePath,
forall fm. LoadedFile fm -> ImportName
lfImportName :: ImportName,
forall fm. LoadedFile fm -> fm
lfMod :: fm,
forall fm. LoadedFile fm -> UTCTime
lfModTime :: UTCTime
}
deriving (LoadedFile fm -> LoadedFile fm -> Bool
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, LoadedFile fm -> LoadedFile fm -> Bool
LoadedFile fm -> LoadedFile fm -> Ordering
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
Ord, Int -> LoadedFile fm -> ShowS
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)
data ProgError
= ProgError Loc (Doc ())
|
ProgWarning Loc (Doc ())
type WithErrors = Either (NE.NonEmpty ProgError)
instance Located ProgError where
locOf :: ProgError -> Loc
locOf (ProgError Loc
l Doc ()
_) = Loc
l
locOf (ProgWarning Loc
l Doc ()
_) = Loc
l
type VFS = M.Map FilePath T.Text
newtype UncheckedImport = UncheckedImport
{ UncheckedImport
-> WithErrors
(LoadedFile UncheckedProg,
[((ImportName, Loc), MVar UncheckedImport)])
unChecked ::
WithErrors (LoadedFile E.UncheckedProg, [((ImportName, Loc), MVar UncheckedImport)])
}
type ReaderState = MVar (M.Map ImportName (Maybe (MVar UncheckedImport)))
newState :: [ImportName] -> IO ReaderState
newState :: [ImportName] -> IO ReaderState
newState [ImportName]
known = forall a. a -> IO (MVar a)
newMVar forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [ImportName]
known forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat forall a. Maybe a
Nothing
orderedImports ::
[((ImportName, Loc), MVar UncheckedImport)] ->
IO [(ImportName, WithErrors (LoadedFile E.UncheckedProg))]
orderedImports :: [((ImportName, Loc), MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
orderedImports = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {m :: * -> *}.
(MonadIO m,
MonadState
[(ImportName, WithErrors (LoadedFile UncheckedProg))] m) =>
[ImportName] -> ((ImportName, Loc), MVar UncheckedImport) -> m ()
spelunk [])
where
spelunk :: [ImportName] -> ((ImportName, Loc), MVar UncheckedImport) -> m ()
spelunk [ImportName]
steps ((ImportName
include, Loc
loc), MVar UncheckedImport
mvar)
| ImportName
include forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImportName]
steps = do
let problem :: ProgError
problem =
Loc -> Doc () -> ProgError
ProgError Loc
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$
FilePath
"Import cycle: "
forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate
FilePath
" -> "
(forall a b. (a -> b) -> [a] -> [b]
map ImportName -> FilePath
includeToString forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ ImportName
include forall a. a -> [a] -> [a]
: [ImportName]
steps)
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, forall a b. a -> Either a b
Left (forall a. a -> NonEmpty a
NE.singleton ProgError
problem)) :)
| Bool
otherwise = do
Maybe (WithErrors (LoadedFile UncheckedProg))
prev <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ImportName
include
case Maybe (WithErrors (LoadedFile UncheckedProg))
prev of
Just WithErrors (LoadedFile UncheckedProg)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe (WithErrors (LoadedFile UncheckedProg))
Nothing -> do
WithErrors
(LoadedFile UncheckedProg,
[((ImportName, Loc), MVar UncheckedImport)])
res <- UncheckedImport
-> WithErrors
(LoadedFile UncheckedProg,
[((ImportName, Loc), MVar UncheckedImport)])
unChecked forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. MVar a -> IO a
readMVar MVar UncheckedImport
mvar)
case WithErrors
(LoadedFile UncheckedProg,
[((ImportName, Loc), MVar UncheckedImport)])
res of
Left NonEmpty ProgError
errors ->
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, forall a b. a -> Either a b
Left NonEmpty ProgError
errors) :)
Right (LoadedFile UncheckedProg
file, [((ImportName, Loc), MVar UncheckedImport)]
more_imports) -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ImportName] -> ((ImportName, Loc), MVar UncheckedImport) -> m ()
spelunk (ImportName
include forall a. a -> [a] -> [a]
: [ImportName]
steps)) [((ImportName, Loc), MVar UncheckedImport)]
more_imports
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, forall a b. b -> Either a b
Right LoadedFile UncheckedProg
file) :)
errorsToTop ::
[(ImportName, WithErrors (LoadedFile E.UncheckedProg))] ->
WithErrors [(ImportName, LoadedFile E.UncheckedProg)]
errorsToTop :: [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
errorsToTop [] = forall a b. b -> Either a b
Right []
errorsToTop ((ImportName
_, Left NonEmpty ProgError
x) : [(ImportName, WithErrors (LoadedFile UncheckedProg))]
rest) =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty ProgError
x <>)) (forall a b. a -> b -> a
const (forall a b. a -> Either a b
Left NonEmpty ProgError
x)) ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
errorsToTop [(ImportName, WithErrors (LoadedFile UncheckedProg))]
rest)
errorsToTop ((ImportName
name, Right LoadedFile UncheckedProg
x) : [(ImportName, WithErrors (LoadedFile UncheckedProg))]
rest) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ImportName
name, LoadedFile UncheckedProg
x) :) ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
errorsToTop [(ImportName, WithErrors (LoadedFile UncheckedProg))]
rest)
newImportMVar :: IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar :: IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar IO UncheckedImport
m = do
MVar UncheckedImport
mvar <- forall a. IO (MVar a)
newEmptyMVar
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar UncheckedImport
mvar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UncheckedImport
m
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just MVar UncheckedImport
mvar
contentsAndModTime :: FilePath -> VFS -> IO (Maybe (Either String (T.Text, UTCTime)))
contentsAndModTime :: FilePath -> VFS -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
filepath VFS
vfs = do
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
filepath VFS
vfs of
Maybe Text
Nothing -> forall a. IO a -> IO (Maybe (Either FilePath a))
interactWithFileSafely forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
T.readFile FilePath
filepath forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO UTCTime
getModificationTime FilePath
filepath
Just Text
file_contents -> do
UTCTime
now <- IO UTCTime
getCurrentTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Text
file_contents, UTCTime
now)
readImportFile :: ImportName -> Loc -> VFS -> IO (Either ProgError (LoadedFile T.Text))
readImportFile :: ImportName -> Loc -> VFS -> IO (Either ProgError (LoadedFile Text))
readImportFile ImportName
include Loc
loc VFS
vfs = do
let filepath :: FilePath
filepath = ImportName -> FilePath
includeToFilePath ImportName
include
Maybe (Either FilePath (Text, UTCTime))
r <- FilePath -> VFS -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
filepath VFS
vfs
case (Maybe (Either FilePath (Text, UTCTime))
r, 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
_) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall {fm}. FilePath -> fm -> UTCTime -> LoadedFile fm
loaded FilePath
filepath Text
s UTCTime
mod_time
(Just (Left FilePath
e), Maybe Text
_) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Loc -> Doc () -> ProgError
ProgError Loc
loc forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty FilePath
e
(Maybe (Either FilePath (Text, UTCTime))
Nothing, Just Text
s) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall {fm}. FilePath -> fm -> UTCTime -> LoadedFile fm
loaded FilePath
prelude_str Text
s UTCTime
startupTime
(Maybe (Either FilePath (Text, UTCTime))
Nothing, Maybe Text
Nothing) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Loc -> Doc () -> ProgError
ProgError Loc
loc forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty Text
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
{ lfImportName :: ImportName
lfImportName = ImportName
include,
lfPath :: FilePath
lfPath = FilePath
path,
lfMod :: fm
lfMod = fm
s,
lfModTime :: UTCTime
lfModTime = UTCTime
mod_time
}
not_found :: Text
not_found =
Text
"Could not find import " forall a. Semigroup a => a -> a -> a
<> Text -> Text
E.quote (ImportName -> Text
includeToText ImportName
include) forall a. Semigroup a => a -> a -> a
<> Text
"."
handleFile :: ReaderState -> VFS -> LoadedFile T.Text -> IO UncheckedImport
handleFile :: ReaderState -> VFS -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar VFS
vfs (LoadedFile FilePath
file_name ImportName
import_name Text
file_contents UTCTime
mod_time) = do
case FilePath -> Text -> Either SyntaxError UncheckedProg
parseFuthark FilePath
file_name Text
file_contents of
Left (SyntaxError Loc
loc Text
err) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrors
(LoadedFile UncheckedProg,
[((ImportName, Loc), MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a
NE.singleton forall a b. (a -> b) -> a -> b
$ Loc -> Doc () -> ProgError
ProgError Loc
loc forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty Text
err
Right UncheckedProg
prog -> do
let imports :: [(ImportName, Loc)]
imports = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a b. (a -> b) -> a -> b
$ ImportName -> FilePath -> ImportName
mkImportFrom ImportName
import_name) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ProgBase f vn -> [(FilePath, Loc)]
E.progImports UncheckedProg
prog
[((ImportName, Loc), MVar UncheckedImport)]
mvars <-
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [(ImportName, Loc)]
imports
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ ReaderState
-> VFS -> ImportName -> Loc -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar VFS
vfs) [(ImportName, Loc)]
imports
let file :: LoadedFile UncheckedProg
file =
LoadedFile
{ lfPath :: FilePath
lfPath = FilePath
file_name,
lfImportName :: ImportName
lfImportName = ImportName
import_name,
lfModTime :: UTCTime
lfModTime = UTCTime
mod_time,
lfMod :: UncheckedProg
lfMod = UncheckedProg
prog
}
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ WithErrors
(LoadedFile UncheckedProg,
[((ImportName, Loc), MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (LoadedFile UncheckedProg
file, [((ImportName, Loc), MVar UncheckedImport)]
mvars)
readImport :: ReaderState -> VFS -> ImportName -> Loc -> IO (Maybe (MVar UncheckedImport))
readImport :: ReaderState
-> VFS -> ImportName -> Loc -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar VFS
vfs ImportName
include Loc
loc =
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar ReaderState
state_mvar forall a b. (a -> b) -> a -> b
$ \Map ImportName (Maybe (MVar UncheckedImport))
state ->
case 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 -> 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 forall a b. (a -> b) -> a -> b
$ do
ImportName -> Loc -> VFS -> IO (Either ProgError (LoadedFile Text))
readImportFile ImportName
include Loc
loc VFS
vfs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left ProgError
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ WithErrors
(LoadedFile UncheckedProg,
[((ImportName, Loc), MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. a -> NonEmpty a
NE.singleton ProgError
e
Right LoadedFile Text
file -> ReaderState -> VFS -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar VFS
vfs LoadedFile Text
file
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 ::
[ImportName] ->
VFS ->
[FilePath] ->
IO (Either (NE.NonEmpty ProgError) [LoadedFile E.UncheckedProg])
readUntypedLibraryExceptKnown :: [ImportName]
-> VFS
-> [FilePath]
-> IO (Either (NonEmpty ProgError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown [ImportName]
known VFS
vfs [FilePath]
fps = do
ReaderState
state_mvar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ReaderState
-> VFS -> ImportName -> Loc -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar VFS
vfs ImportName
prelude_import forall a. Monoid a => a
mempty
[((ImportName, Loc), Maybe (MVar UncheckedImport))]
fps_mvars <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {b}.
Monoid b =>
ReaderState
-> FilePath -> IO ((ImportName, b), Maybe (MVar UncheckedImport))
onFile ReaderState
state_mvar) [FilePath]
fps)
let unknown_mvars :: [((ImportName, Loc), MVar UncheckedImport)]
unknown_mvars = forall {a}.
[((ImportName, Loc), Maybe a)] -> [((ImportName, Loc), a)]
onlyUnknown (((ImportName
prelude_import, forall a. Monoid a => a
mempty), Maybe (MVar UncheckedImport)
prelude_mvar) forall a. a -> [a] -> [a]
: [((ImportName, Loc), Maybe (MVar UncheckedImport))]
fps_mvars)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
errorsToTop forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [((ImportName, Loc), MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
orderedImports [((ImportName, Loc), MVar UncheckedImport)]
unknown_mvars
where
onlyUnknown :: [((ImportName, Loc), Maybe a)] -> [((ImportName, Loc), a)]
onlyUnknown = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
onFile :: ReaderState
-> FilePath -> IO ((ImportName, b), Maybe (MVar UncheckedImport))
onFile ReaderState
state_mvar FilePath
fp =
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar ReaderState
state_mvar forall a b. (a -> b) -> a -> b
$ \Map ImportName (Maybe (MVar UncheckedImport))
state -> do
case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ImportName (Maybe (MVar UncheckedImport))
state, ((ImportName
include, forall a. Monoid a => a
mempty), Maybe (MVar UncheckedImport)
prog_mvar))
Maybe (Maybe (MVar UncheckedImport))
Nothing -> do
Maybe (MVar UncheckedImport)
prog_mvar <- IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar forall a b. (a -> b) -> a -> b
$ do
if ShowS
takeExtension FilePath
fp forall a. Eq a => a -> a -> Bool
/= FilePath
".fut"
then
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrors
(LoadedFile UncheckedProg,
[((ImportName, Loc), MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a
NE.singleton forall a b. (a -> b) -> a -> b
$
Loc -> Doc () -> ProgError
ProgError Loc
NoLoc forall a b. (a -> b) -> a -> b
$
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
fp forall a. Semigroup a => a -> a -> a
<> Doc ()
": source files must have a .fut extension."
else do
Maybe (Either FilePath (Text, UTCTime))
r <- FilePath -> VFS -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
fp VFS
vfs
case Maybe (Either FilePath (Text, UTCTime))
r of
Just (Right (Text
fs, UTCTime
mod_time)) -> do
ReaderState -> VFS -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar VFS
vfs forall a b. (a -> b) -> a -> b
$
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) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrors
(LoadedFile UncheckedProg,
[((ImportName, Loc), MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a
NE.singleton forall a b. (a -> b) -> a -> b
$
Loc -> Doc () -> ProgError
ProgError Loc
NoLoc forall a b. (a -> b) -> a -> b
$
forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$
forall a. Show a => a -> FilePath
show FilePath
e
Maybe (Either FilePath (Text, UTCTime))
Nothing ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrors
(LoadedFile UncheckedProg,
[((ImportName, Loc), MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a
NE.singleton forall a b. (a -> b) -> a -> b
$
Loc -> Doc () -> ProgError
ProgError Loc
NoLoc forall a b. (a -> b) -> a -> b
$
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
fp forall a. Semigroup a => a -> a -> a
<> Doc ()
": file not found."
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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, forall a. Monoid a => a
mempty), 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
data CheckedFile = CheckedFile
{
CheckedFile -> VNameSource
cfNameSource :: VNameSource,
CheckedFile -> Warnings
cfWarnings :: Warnings,
CheckedFile -> FileModule
cfMod :: FileModule
}
asImports :: [LoadedFile CheckedFile] -> Imports
asImports :: [LoadedFile CheckedFile] -> Imports
asImports = forall a b. (a -> b) -> [a] -> [b]
map LoadedFile CheckedFile -> (ImportName, FileModule)
f
where
f :: LoadedFile CheckedFile -> (ImportName, FileModule)
f LoadedFile CheckedFile
lf = (forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile CheckedFile
lf, CheckedFile -> FileModule
cfMod forall a b. (a -> b) -> a -> b
$ forall fm. LoadedFile fm -> fm
lfMod LoadedFile CheckedFile
lf)
typeCheckProg ::
[LoadedFile CheckedFile] ->
VNameSource ->
[LoadedFile E.UncheckedProg] ->
WithErrors ([LoadedFile CheckedFile], VNameSource)
typeCheckProg :: [LoadedFile CheckedFile]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
typeCheckProg [LoadedFile CheckedFile]
orig_imports VNameSource
orig_src =
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([LoadedFile CheckedFile], VNameSource)
-> LoadedFile UncheckedProg
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
f ([LoadedFile CheckedFile]
orig_imports, VNameSource
orig_src)
where
roots :: [FilePath]
roots = [FilePath
"/prelude/prelude"]
f :: ([LoadedFile CheckedFile], VNameSource)
-> LoadedFile UncheckedProg
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
f ([LoadedFile CheckedFile]
imports, VNameSource
src) (LoadedFile FilePath
path ImportName
import_name UncheckedProg
prog UTCTime
mod_time) = do
let prog' :: UncheckedProg
prog'
| FilePath -> Bool
isBuiltin (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 CheckedFile] -> Imports
asImports [LoadedFile CheckedFile]
imports) VNameSource
src ImportName
import_name UncheckedProg
prog' of
(Warnings
prog_ws, Left (E.TypeError Loc
loc Notes
notes Doc ()
msg)) -> do
let err' :: Doc ()
err' = Doc ()
msg forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Notes
notes
warningToError :: (a, Doc ()) -> ProgError
warningToError (a
wloc, Doc ()
wmsg) = Loc -> Doc () -> ProgError
ProgWarning (forall a. Located a => a -> Loc
locOf a
wloc) Doc ()
wmsg
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
Loc -> Doc () -> ProgError
ProgError (forall a. Located a => a -> Loc
locOf Loc
loc) Doc ()
err'
forall a. a -> [a] -> NonEmpty a
NE.:| forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Located a => (a, Doc ()) -> ProgError
warningToError (Warnings -> [(SrcLoc, Doc ())]
listWarnings Warnings
prog_ws)
(Warnings
prog_ws, Right (FileModule
m, VNameSource
src')) ->
let warnHole :: (a, a) -> Warnings
warnHole (a
loc, a
t) =
SrcLoc -> Doc () -> Warnings
singleWarning (forall a. Located a => a -> SrcLoc
E.srclocOf a
loc) forall a b. (a -> b) -> a -> b
$ Doc ()
"Hole of type: " forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty a
t)
prog_ws' :: Warnings
prog_ws' = Warnings
prog_ws forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a} {a}. (Located a, Pretty a) => (a, a) -> Warnings
warnHole (ProgBase Info VName -> [(Loc, StructType)]
E.progHoles (FileModule -> ProgBase Info VName
fileProg FileModule
m))
in forall a b. b -> Either a b
Right
( [LoadedFile CheckedFile]
imports forall a. [a] -> [a] -> [a]
++ [forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile FilePath
path ImportName
import_name (VNameSource -> Warnings -> FileModule -> CheckedFile
CheckedFile VNameSource
src Warnings
prog_ws' 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 = forall a b. (a -> b) -> [a] -> [b]
map LoadedFile UncheckedProg -> LoadedFile UncheckedProg
onFile
where
fps' :: [FilePath]
fps' = forall a b. (a -> b) -> [a] -> [b]
map ShowS
normalise [FilePath]
fps
onFile :: LoadedFile UncheckedProg -> LoadedFile UncheckedProg
onFile LoadedFile UncheckedProg
lf
| ImportName -> FilePath
includeToFilePath (forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile UncheckedProg
lf) 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 = forall a b. (a -> b) -> [a] -> [b]
map DecBase NoInfo Name -> DecBase NoInfo Name
onDec (forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
E.progDecs UncheckedProg
prog)}}
| Bool
otherwise =
LoadedFile UncheckedProg
lf
where
prog :: UncheckedProg
prog = forall fm. LoadedFile fm -> fm
lfMod LoadedFile UncheckedProg
lf
onDec :: DecBase NoInfo Name -> DecBase NoInfo Name
onDec (E.ValDec ValBindBase NoInfo Name
vb)
| forall (f :: * -> *) vn. ValBindBase f vn -> vn
E.valBindName ValBindBase NoInfo Name
vb forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
extra_eps =
forall (f :: * -> *) vn. ValBindBase f vn -> DecBase f vn
E.ValDec ValBindBase NoInfo Name
vb {valBindEntryPoint :: Maybe (NoInfo EntryPoint)
E.valBindEntryPoint = forall a. a -> Maybe a
Just forall {k} (a :: k). 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) =
forall (f :: * -> *) vn.
Maybe DocComment -> [DecBase f vn] -> ProgBase f vn
E.Prog Maybe DocComment
doc forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {vn}. FilePath -> DecBase NoInfo vn
mkImport [FilePath]
roots forall a. [a] -> [a] -> [a]
++ [DecBase NoInfo Name]
ds
where
mkImport :: FilePath -> DecBase NoInfo vn
mkImport FilePath
fp =
forall (f :: * -> *) vn. DecBase f vn -> SrcLoc -> DecBase f vn
E.LocalDec (forall (f :: * -> *) vn. ModExpBase f vn -> SrcLoc -> DecBase f vn
E.OpenDec (forall (f :: * -> *) vn.
FilePath -> f ImportName -> SrcLoc -> ModExpBase f vn
E.ModImport FilePath
fp forall {k} (a :: k). NoInfo a
E.NoInfo forall a. Monoid a => a
mempty) forall a. Monoid a => a
mempty) forall a. Monoid a => a
mempty
data LoadedProg = LoadedProg
{ LoadedProg -> [FilePath]
lpRoots :: [FilePath],
LoadedProg -> [LoadedFile CheckedFile]
lpFiles :: [LoadedFile CheckedFile],
LoadedProg -> VNameSource
lpNameSource :: VNameSource
}
lpImports :: LoadedProg -> Imports
lpImports :: LoadedProg -> Imports
lpImports = forall a b. (a -> b) -> [a] -> [b]
map LoadedFile CheckedFile -> (ImportName, FileModule)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedProg -> [LoadedFile CheckedFile]
lpFiles
where
f :: LoadedFile CheckedFile -> (ImportName, FileModule)
f LoadedFile CheckedFile
lf = (forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile CheckedFile
lf, CheckedFile -> FileModule
cfMod forall a b. (a -> b) -> a -> b
$ forall fm. LoadedFile fm -> fm
lfMod LoadedFile CheckedFile
lf)
lpWarnings :: LoadedProg -> Warnings
lpWarnings :: LoadedProg -> Warnings
lpWarnings = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CheckedFile -> Warnings
cfWarnings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fm. LoadedFile fm -> fm
lfMod) forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedProg -> [LoadedFile CheckedFile]
lpFiles
lpFilePaths :: LoadedProg -> [FilePath]
lpFilePaths :: LoadedProg -> [FilePath]
lpFilePaths = forall a b. (a -> b) -> [a] -> [b]
map forall fm. LoadedFile fm -> FilePath
lfPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedProg -> [LoadedFile CheckedFile]
lpFiles
unchangedImports ::
MonadIO m =>
VNameSource ->
VFS ->
[LoadedFile CheckedFile] ->
m ([LoadedFile CheckedFile], VNameSource)
unchangedImports :: forall (m :: * -> *).
MonadIO m =>
VNameSource
-> VFS
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
unchangedImports VNameSource
src VFS
_ [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], VNameSource
src)
unchangedImports VNameSource
src VFS
vfs (LoadedFile CheckedFile
f : [LoadedFile CheckedFile]
fs)
| FilePath -> Bool
isBuiltin (ImportName -> FilePath
includeToFilePath (forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile CheckedFile
f)) =
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (LoadedFile CheckedFile
f :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
VNameSource
-> VFS
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
unchangedImports VNameSource
src VFS
vfs [LoadedFile CheckedFile]
fs
| Bool
otherwise = do
let file_path :: FilePath
file_path = forall fm. LoadedFile fm -> FilePath
lfPath LoadedFile CheckedFile
f
if forall k a. Ord k => k -> Map k a -> Bool
M.member FilePath
file_path VFS
vfs
then forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], CheckedFile -> VNameSource
cfNameSource forall a b. (a -> b) -> a -> b
$ forall fm. LoadedFile fm -> fm
lfMod LoadedFile CheckedFile
f)
else do
Bool
changed <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
True) (forall a. Ord a => a -> a -> Bool
> forall fm. LoadedFile fm -> UTCTime
lfModTime LoadedFile CheckedFile
f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IO a -> IO (Maybe (Either FilePath a))
interactWithFileSafely (FilePath -> IO UTCTime
getModificationTime FilePath
file_path))
if Bool
changed
then forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], CheckedFile -> VNameSource
cfNameSource forall a b. (a -> b) -> a -> b
$ forall fm. LoadedFile fm -> fm
lfMod LoadedFile CheckedFile
f)
else forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (LoadedFile CheckedFile
f :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
VNameSource
-> VFS
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
unchangedImports VNameSource
src VFS
vfs [LoadedFile CheckedFile]
fs
noLoadedProg :: LoadedProg
noLoadedProg :: LoadedProg
noLoadedProg =
LoadedProg
{ lpRoots :: [FilePath]
lpRoots = [],
lpFiles :: [LoadedFile CheckedFile]
lpFiles = forall a. Monoid a => a
mempty,
lpNameSource :: VNameSource
lpNameSource = Int -> VNameSource
newNameSource forall a b. (a -> b) -> a -> b
$ Int
E.maxIntrinsicTag forall a. Num a => a -> a -> a
+ Int
1
}
usableLoadedProg :: MonadIO m => LoadedProg -> VFS -> [FilePath] -> m LoadedProg
usableLoadedProg :: forall (m :: * -> *).
MonadIO m =>
LoadedProg -> VFS -> [FilePath] -> m LoadedProg
usableLoadedProg (LoadedProg [FilePath]
roots [LoadedFile CheckedFile]
imports VNameSource
src) VFS
vfs [FilePath]
new_roots
| forall a. Ord a => [a] -> [a]
sort [FilePath]
roots forall a. Eq a => a -> a -> Bool
== forall a. Ord a => [a] -> [a]
sort [FilePath]
new_roots = do
([LoadedFile CheckedFile]
imports', VNameSource
src') <- forall (m :: * -> *).
MonadIO m =>
VNameSource
-> VFS
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
unchangedImports VNameSource
src VFS
vfs [LoadedFile CheckedFile]
imports
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FilePath] -> [LoadedFile CheckedFile] -> VNameSource -> LoadedProg
LoadedProg [] [LoadedFile CheckedFile]
imports' VNameSource
src'
| Bool
otherwise =
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoadedProg
noLoadedProg
extendProg ::
LoadedProg ->
[FilePath] ->
VFS ->
IO (Either (NE.NonEmpty ProgError) LoadedProg)
extendProg :: LoadedProg
-> [FilePath] -> VFS -> IO (Either (NonEmpty ProgError) LoadedProg)
extendProg LoadedProg
lp [FilePath]
new_roots VFS
vfs = do
Either (NonEmpty ProgError) [LoadedFile UncheckedProg]
new_imports_untyped <-
[ImportName]
-> VFS
-> [FilePath]
-> IO (Either (NonEmpty ProgError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown (forall a b. (a -> b) -> [a] -> [b]
map forall fm. LoadedFile fm -> ImportName
lfImportName forall a b. (a -> b) -> a -> b
$ LoadedProg -> [LoadedFile CheckedFile]
lpFiles LoadedProg
lp) VFS
vfs [FilePath]
new_roots
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
([LoadedFile CheckedFile]
imports, VNameSource
src') <-
[LoadedFile CheckedFile]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
typeCheckProg (LoadedProg -> [LoadedFile CheckedFile]
lpFiles LoadedProg
lp) (LoadedProg -> VNameSource
lpNameSource LoadedProg
lp) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either (NonEmpty ProgError) [LoadedFile UncheckedProg]
new_imports_untyped
forall a b. b -> Either a b
Right ([FilePath] -> [LoadedFile CheckedFile] -> VNameSource -> LoadedProg
LoadedProg (forall a. Ord a => [a] -> [a]
nubOrd (LoadedProg -> [FilePath]
lpRoots LoadedProg
lp forall a. [a] -> [a] -> [a]
++ [FilePath]
new_roots)) [LoadedFile CheckedFile]
imports VNameSource
src')
reloadProg ::
LoadedProg ->
[FilePath] ->
VFS ->
IO (Either (NE.NonEmpty ProgError) LoadedProg)
reloadProg :: LoadedProg
-> [FilePath] -> VFS -> IO (Either (NonEmpty ProgError) LoadedProg)
reloadProg LoadedProg
lp [FilePath]
new_roots VFS
vfs = do
LoadedProg
lp' <- forall (m :: * -> *).
MonadIO m =>
LoadedProg -> VFS -> [FilePath] -> m LoadedProg
usableLoadedProg LoadedProg
lp VFS
vfs [FilePath]
new_roots
LoadedProg
-> [FilePath] -> VFS -> IO (Either (NonEmpty ProgError) LoadedProg)
extendProg LoadedProg
lp' [FilePath]
new_roots VFS
vfs
readLibrary ::
[E.Name] ->
[FilePath] ->
IO (Either (NE.NonEmpty ProgError) (E.Warnings, Imports, VNameSource))
readLibrary :: [Name]
-> [FilePath]
-> IO
(Either (NonEmpty ProgError) (Warnings, Imports, VNameSource))
readLibrary [Name]
extra_eps [FilePath]
fps =
( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {c}. ([LoadedFile CheckedFile], c) -> (Warnings, Imports, c)
frob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LoadedFile CheckedFile]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
typeCheckProg forall a. Monoid a => a
mempty (LoadedProg -> VNameSource
lpNameSource LoadedProg
noLoadedProg)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Name]
-> [FilePath]
-> [LoadedFile UncheckedProg]
-> [LoadedFile UncheckedProg]
setEntryPoints (Name
E.defaultEntryPoint forall a. a -> [a] -> [a]
: [Name]
extra_eps) [FilePath]
fps)
)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportName]
-> VFS
-> [FilePath]
-> IO (Either (NonEmpty ProgError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown [] forall k a. Map k a
M.empty [FilePath]
fps
where
frob :: ([LoadedFile CheckedFile], c) -> (Warnings, Imports, c)
frob ([LoadedFile CheckedFile]
y, c
z) = (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CheckedFile -> Warnings
cfWarnings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fm. LoadedFile fm -> fm
lfMod) [LoadedFile CheckedFile]
y, [LoadedFile CheckedFile] -> Imports
asImports [LoadedFile CheckedFile]
y, c
z)
readUntypedLibrary ::
[FilePath] ->
IO (Either (NE.NonEmpty ProgError) [(ImportName, E.UncheckedProg)])
readUntypedLibrary :: [FilePath]
-> IO (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)])
readUntypedLibrary = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall {b}. LoadedFile b -> (ImportName, b)
f)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportName]
-> VFS
-> [FilePath]
-> IO (Either (NonEmpty ProgError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown [] forall k a. Map k a
M.empty
where
f :: LoadedFile b -> (ImportName, b)
f LoadedFile b
lf = (forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile b
lf, forall fm. LoadedFile fm -> fm
lfMod LoadedFile b
lf)