{-# LANGUAGE LambdaCase #-}

-- | Low-level compilation parts.  Look at "Futhark.Compiler" for a
-- more high-level API.
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.Except
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)
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,
    -- | Modification time of the underlying file.
    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)

-- | Note that the location may be 'NoLoc'.  This essentially only
-- happens when the problem is that a root file cannot be found.
data ProgError
  = ProgError Loc (Doc ())
  | -- | Not actually an error, but we want them reported
    -- with errors.
    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

-- | A mapping from absolute pathnames to pretty representing a virtual
-- file system.  Before loading a file from the file system, this
-- mapping is consulted.  If the desired pathname has an entry here,
-- the corresponding pretty is used instead of loading the file from
-- disk.
type VFS = M.Map FilePath T.Text

newtype UncheckedImport = UncheckedImport
  { UncheckedImport
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
unChecked ::
      WithErrors (LoadedFile E.UncheckedProg, [(ImportName, MVar UncheckedImport)])
  }

-- | If mapped to Nothing, treat it as present.  This is used when
-- reloading programs.
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, MVar UncheckedImport)] ->
  IO [(ImportName, WithErrors (LoadedFile E.UncheckedProg))]
orderedImports :: [(ImportName, 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, MVar UncheckedImport) -> m ()
spelunk [])
  where
    spelunk :: [ImportName] -> (ImportName, MVar UncheckedImport) -> m ()
spelunk [ImportName]
steps (ImportName
include, 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 (forall a. Located a => a -> Loc
locOf ImportName
include) 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, MVar UncheckedImport)])
res <- UncheckedImport
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, 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, 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, MVar UncheckedImport)]
more_imports) -> do
                  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ImportName] -> (ImportName, MVar UncheckedImport) -> m ()
spelunk (ImportName
include forall a. a -> [a] -> [a]
: [ImportName]
steps)) [(ImportName, 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

-- | Read the content and modification time of a file.
-- Check if the file exits in VFS before interact with file system directly.
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 -> VFS -> IO (Either ProgError (LoadedFile T.Text))
readImportFile :: ImportName -> VFS -> IO (Either ProgError (LoadedFile Text))
readImportFile ImportName
include VFS
vfs = do
  -- First we try to find a file of the given name in the search path,
  -- then we look at the builtin library if we have to.  For the
  -- builtins, we don't use the search path.
  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 (forall a. Located a => a -> Loc
locOf ImportName
include) 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 (forall a. Located a => a -> Loc
locOf ImportName
include) 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, 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]
imports = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ImportName -> FilePath -> SrcLoc -> ImportName
mkImportFrom ImportName
import_name)) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) vn. ProgBase f vn -> [(FilePath, SrcLoc)]
E.progImports UncheckedProg
prog
      [(ImportName, 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]
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 (ReaderState
-> VFS -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar VFS
vfs) [ImportName]
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, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (LoadedFile UncheckedProg
file, [(ImportName, MVar UncheckedImport)]
mvars)

readImport :: ReaderState -> VFS -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport :: ReaderState
-> VFS -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar VFS
vfs ImportName
include =
  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 -> VFS -> IO (Either ProgError (LoadedFile Text))
readImportFile ImportName
include 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, 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 -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar VFS
vfs ImportName
prelude_import
  [(ImportName, 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 (ReaderState
-> FilePath -> IO (ImportName, Maybe (MVar UncheckedImport))
onFile ReaderState
state_mvar) [FilePath]
fps)
  let unknown_mvars :: [(ImportName, MVar UncheckedImport)]
unknown_mvars = forall {a}. [(ImportName, Maybe a)] -> [(ImportName, a)]
onlyUnknown ((ImportName
prelude_import, Maybe (MVar UncheckedImport)
prelude_mvar) forall a. a -> [a] -> [a]
: [(ImportName, 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, MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
orderedImports [(ImportName, MVar UncheckedImport)]
unknown_mvars
  where
    onlyUnknown :: [(ImportName, Maybe a)] -> [(ImportName, 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, 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, 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
              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, 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, 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
$
                        FilePath
fp forall a. Semigroup a => a -> a -> a
<> FilePath
": 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, 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

-- | A type-checked file.
data CheckedFile = CheckedFile
  { -- | The name generation state after checking this file.
    CheckedFile -> VNameSource
cfNameSource :: VNameSource,
    -- | The warnings that were issued from checking this file.
    CheckedFile -> Warnings
cfWarnings :: Warnings,
    -- | The type-checked file.
    CheckedFile -> FileModule
cfMod :: FileModule
  }

asImports :: [LoadedFile CheckedFile] -> Imports
asImports :: [LoadedFile CheckedFile] -> Imports
asImports = forall a b. (a -> b) -> [a] -> [b]
map LoadedFile CheckedFile -> (FilePath, FileModule)
f
  where
    f :: LoadedFile CheckedFile -> (FilePath, FileModule)
f LoadedFile CheckedFile
lf = (ImportName -> FilePath
includeToString (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 =
      -- We do not use ImportDec here, because we do not want the
      -- type checker to issue a warning about a redundant import.
      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 FilePath -> 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

-- | A loaded, type-checked program.  This can be used to extract
-- information about the program, but also to speed up subsequent
-- reloads.
data LoadedProg = LoadedProg
  { LoadedProg -> [FilePath]
lpRoots :: [FilePath],
    -- | The 'VNameSource' is the name source just *before* the module
    -- was type checked.
    LoadedProg -> [LoadedFile CheckedFile]
lpFiles :: [LoadedFile CheckedFile],
    -- | Final name source.
    LoadedProg -> VNameSource
lpNameSource :: VNameSource
  }

-- | The 'Imports' of a 'LoadedProg', as expected by e.g. type
-- checking functions.
lpImports :: LoadedProg -> Imports
lpImports :: LoadedProg -> Imports
lpImports = forall a b. (a -> b) -> [a] -> [b]
map LoadedFile CheckedFile -> (FilePath, FileModule)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedProg -> [LoadedFile CheckedFile]
lpFiles
  where
    f :: LoadedFile CheckedFile -> (FilePath, FileModule)
f LoadedFile CheckedFile
lf = (ImportName -> FilePath
includeToString (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)

-- | All warnings of a 'LoadedProg'.
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

-- | The absolute paths of the files that are part of this program.
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

-- | A "loaded program" containing no actual files.  Use this as a
-- starting point for 'reloadProg'
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
    }

-- | Find out how many of the old imports can be used.  Here we are
-- forced to be overly conservative, because our type checker
-- enforces a linear ordering.
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

-- | Extend a loaded program with (possibly new) files.
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')

-- | Load some new files, reusing as much of the previously loaded
-- program as possible.  This does not *extend* the currently loaded
-- program the way 'extendProg' does it, so it is always correct (if
-- less efficient) to pass 'noLoadedProg'.
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

-- | Read and type-check some Futhark files.
readLibrary ::
  -- | Extra functions that should be marked as entry points; only
  -- applies to the immediate files, not any imports imported.
  [E.Name] ->
  -- | The files to read.
  [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)

-- | Read (and parse) all source files (including the builtin prelude)
-- corresponding to a set of root files.
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)