{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Low-level compilation parts.  Look at "Futhark.Compiler" for a
-- more high-level API.
module Futhark.Compiler.Program
  ( readLibrary,
    readUntypedLibrary,
    Imports,
    FileModule (..),
    E.Warnings,
    ProgramError (..),
    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.List.NonEmpty as NE
import Data.Loc (Loc (..), locOf)
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.FreshNames
import Futhark.Util (interactWithFileSafely, nubOrd, startupTime)
import Futhark.Util.Pretty (Doc, line, ppr, text, (</>))
import qualified Language.Futhark as E
import Language.Futhark.Parser (SyntaxError (..), parseFuthark)
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,
    -- | Modification time of the underlying file.
    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)

-- | Note that the location may be 'NoLoc'.  This essentially only
-- happens when the problem is that a root file cannot be found.
data ProgramError = ProgramError Loc Doc

type WithErrors = Either (NE.NonEmpty ProgramError)

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 = 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

-- Since we need to work with base 4.14 that does not have NE.singleton.
singleError :: ProgramError -> NE.NonEmpty ProgramError
singleError :: ProgramError -> NonEmpty ProgramError
singleError = (ProgramError -> [ProgramError] -> NonEmpty ProgramError
forall a. a -> [a] -> NonEmpty a
NE.:| [])

orderedImports ::
  [(ImportName, MVar UncheckedImport)] ->
  IO [(ImportName, WithErrors (LoadedFile E.UncheckedProg))]
orderedImports :: [(ImportName, MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
orderedImports = ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
 -> [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall a. [a] -> [a]
reverse (IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
 -> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> ([(ImportName, MVar UncheckedImport)]
    -> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> [(ImportName, MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
 -> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
 -> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> StateT
     [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT [] (StateT [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
 -> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> ([(ImportName, MVar UncheckedImport)]
    -> StateT
         [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ())
-> [(ImportName, MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ImportName, MVar UncheckedImport)
 -> StateT
      [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ())
-> [(ImportName, MVar UncheckedImport)]
-> StateT
     [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ImportName]
-> (ImportName, MVar UncheckedImport)
-> StateT
     [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
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 ImportName -> [ImportName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImportName]
steps = do
        let problem :: ProgramError
problem =
              Loc -> Doc -> ProgramError
ProgramError (ImportName -> Loc
forall a. Located a => a -> Loc
locOf ImportName
include) (Doc -> ProgramError)
-> (FilePath -> Doc) -> FilePath -> ProgramError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Doc
text (FilePath -> ProgramError) -> FilePath -> ProgramError
forall a b. (a -> b) -> a -> b
$
                FilePath
"Import cycle: "
                  FilePath -> ShowS
forall a. Semigroup 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)
        ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
 -> [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, NonEmpty ProgramError -> WithErrors (LoadedFile UncheckedProg)
forall a b. a -> Either a b
Left (ProgramError -> NonEmpty ProgramError
singleError ProgramError
problem)) (ImportName, WithErrors (LoadedFile UncheckedProg))
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall a. a -> [a] -> [a]
:)
      | Bool
otherwise = do
        Maybe (WithErrors (LoadedFile UncheckedProg))
prev <- ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
 -> Maybe (WithErrors (LoadedFile UncheckedProg)))
-> m (Maybe (WithErrors (LoadedFile UncheckedProg)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (([(ImportName, WithErrors (LoadedFile UncheckedProg))]
  -> Maybe (WithErrors (LoadedFile UncheckedProg)))
 -> m (Maybe (WithErrors (LoadedFile UncheckedProg))))
-> ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
    -> Maybe (WithErrors (LoadedFile UncheckedProg)))
-> m (Maybe (WithErrors (LoadedFile UncheckedProg)))
forall a b. (a -> b) -> a -> b
$ ImportName
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> Maybe (WithErrors (LoadedFile UncheckedProg))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ImportName
include
        case Maybe (WithErrors (LoadedFile UncheckedProg))
prev of
          Just WithErrors (LoadedFile UncheckedProg)
_ -> () -> m ()
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 (UncheckedImport
 -> WithErrors
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> m UncheckedImport
-> m (WithErrors
        (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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)
            case WithErrors
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
res of
              Left NonEmpty ProgramError
errors ->
                ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
 -> [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, NonEmpty ProgramError -> WithErrors (LoadedFile UncheckedProg)
forall a b. a -> Either a b
Left NonEmpty ProgramError
errors) (ImportName, WithErrors (LoadedFile UncheckedProg))
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall a. a -> [a] -> [a]
:)
              Right (LoadedFile UncheckedProg
file, [(ImportName, MVar UncheckedImport)]
more_imports) -> do
                ((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, WithErrors (LoadedFile UncheckedProg))]
 -> [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, LoadedFile UncheckedProg -> WithErrors (LoadedFile UncheckedProg)
forall a b. b -> Either a b
Right LoadedFile UncheckedProg
file) (ImportName, WithErrors (LoadedFile UncheckedProg))
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall a. a -> [a] -> [a]
:)

errorsToTop ::
  [(ImportName, WithErrors (LoadedFile E.UncheckedProg))] ->
  WithErrors [(ImportName, LoadedFile E.UncheckedProg)]
errorsToTop :: [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
errorsToTop [] = [(ImportName, LoadedFile UncheckedProg)]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a b. b -> Either a b
Right []
errorsToTop ((ImportName
_, Left NonEmpty ProgramError
x) : [(ImportName, WithErrors (LoadedFile UncheckedProg))]
rest) =
  (NonEmpty ProgramError
 -> WithErrors [(ImportName, LoadedFile UncheckedProg)])
-> ([(ImportName, LoadedFile UncheckedProg)]
    -> WithErrors [(ImportName, LoadedFile UncheckedProg)])
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (NonEmpty ProgramError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a b. a -> Either a b
Left (NonEmpty ProgramError
 -> WithErrors [(ImportName, LoadedFile UncheckedProg)])
-> (NonEmpty ProgramError -> NonEmpty ProgramError)
-> NonEmpty ProgramError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty ProgramError
x NonEmpty ProgramError
-> NonEmpty ProgramError -> NonEmpty ProgramError
forall a. Semigroup a => a -> a -> a
<>)) (WithErrors [(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a b. a -> b -> a
const (NonEmpty ProgramError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a b. a -> Either a b
Left NonEmpty ProgramError
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) =
  ([(ImportName, LoadedFile UncheckedProg)]
 -> [(ImportName, LoadedFile UncheckedProg)])
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ImportName
name, LoadedFile UncheckedProg
x) (ImportName, LoadedFile UncheckedProg)
-> [(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)]
forall a. a -> [a] -> [a]
:) ([(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 <- 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 ProgramError (LoadedFile T.Text))
readImportFile :: ImportName -> IO (Either ProgramError (LoadedFile Text))
readImportFile ImportName
include = 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 -> 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 ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgramError (LoadedFile Text)
 -> IO (Either ProgramError (LoadedFile Text)))
-> Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ LoadedFile Text -> Either ProgramError (LoadedFile Text)
forall a b. b -> Either a b
Right (LoadedFile Text -> Either ProgramError (LoadedFile Text))
-> LoadedFile Text -> Either ProgramError (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 ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgramError (LoadedFile Text)
 -> IO (Either ProgramError (LoadedFile Text)))
-> Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ ProgramError -> Either ProgramError (LoadedFile Text)
forall a b. a -> Either a b
Left (ProgramError -> Either ProgramError (LoadedFile Text))
-> ProgramError -> Either ProgramError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ProgramError
ProgramError (ImportName -> Loc
forall a. Located a => a -> Loc
locOf ImportName
include) (Doc -> ProgramError) -> Doc -> ProgramError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
e
    (Maybe (Either FilePath (Text, UTCTime))
Nothing, Just Text
s) ->
      Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgramError (LoadedFile Text)
 -> IO (Either ProgramError (LoadedFile Text)))
-> Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ LoadedFile Text -> Either ProgramError (LoadedFile Text)
forall a b. b -> Either a b
Right (LoadedFile Text -> Either ProgramError (LoadedFile Text))
-> LoadedFile Text -> Either ProgramError (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 ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgramError (LoadedFile Text)
 -> IO (Either ProgramError (LoadedFile Text)))
-> Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ ProgramError -> Either ProgramError (LoadedFile Text)
forall a b. a -> Either a b
Left (ProgramError -> Either ProgramError (LoadedFile Text))
-> ProgramError -> Either ProgramError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ProgramError
ProgramError (ImportName -> Loc
forall a. Located a => a -> Loc
locOf ImportName
include) (Doc -> ProgramError) -> Doc -> ProgramError
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
"Could not find import " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
E.quote (ImportName -> FilePath
includeToString ImportName
include) FilePath -> ShowS
forall a. Semigroup 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 SyntaxError UncheckedProg
parseFuthark FilePath
file_name Text
file_contents of
    Left (SyntaxError Loc
loc FilePath
err) ->
      UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> (ProgramError -> UncheckedImport)
-> ProgramError
-> IO UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrors
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (WithErrors
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> UncheckedImport)
-> (ProgramError
    -> WithErrors
         (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> ProgramError
-> UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ProgramError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgramError
 -> WithErrors
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> (ProgramError -> NonEmpty ProgramError)
-> ProgramError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramError -> NonEmpty ProgramError
singleError (ProgramError -> IO UncheckedImport)
-> ProgramError -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ProgramError
ProgramError Loc
loc (Doc -> ProgramError) -> Doc -> ProgramError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
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
$ WithErrors
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (WithErrors
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> UncheckedImport)
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> WithErrors
     (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 ProgramError (LoadedFile Text))
readImportFile ImportName
include IO (Either ProgramError (LoadedFile Text))
-> (Either ProgramError (LoadedFile Text) -> IO UncheckedImport)
-> IO UncheckedImport
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left ProgramError
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
$ WithErrors
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (WithErrors
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> UncheckedImport)
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ NonEmpty ProgramError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgramError
 -> WithErrors
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> NonEmpty ProgramError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. (a -> b) -> a -> b
$ ProgramError -> NonEmpty ProgramError
singleError ProgramError
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 ::
  [ImportName] ->
  [FilePath] ->
  IO (Either (NE.NonEmpty ProgramError) [LoadedFile E.UncheckedProg])
readUntypedLibraryExceptKnown :: [ImportName]
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown [ImportName]
known [FilePath]
fps = do
  ReaderState
state_mvar <- IO ReaderState -> IO ReaderState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReaderState -> IO ReaderState)
-> IO ReaderState -> IO 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))
-> IO (Maybe (MVar UncheckedImport))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (MVar UncheckedImport))
 -> IO (Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport))
-> IO (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))]
-> IO [(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])
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((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) (WithErrors [(ImportName, LoadedFile UncheckedProg)]
 -> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
    -> WithErrors [(ImportName, LoadedFile UncheckedProg)])
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
errorsToTop ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
 -> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
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 = ((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)
-> (ProgramError -> UncheckedImport)
-> ProgramError
-> IO UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrors
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (WithErrors
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> UncheckedImport)
-> (ProgramError
    -> WithErrors
         (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> ProgramError
-> UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ProgramError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgramError
 -> WithErrors
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> (ProgramError -> NonEmpty ProgramError)
-> ProgramError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramError -> NonEmpty ProgramError
singleError (ProgramError -> IO UncheckedImport)
-> ProgramError -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$
                    Loc -> Doc -> ProgramError
ProgramError Loc
NoLoc (Doc -> ProgramError) -> Doc -> ProgramError
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)
-> (ProgramError -> UncheckedImport)
-> ProgramError
-> IO UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrors
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (WithErrors
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> UncheckedImport)
-> (ProgramError
    -> WithErrors
         (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> ProgramError
-> UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ProgramError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgramError
 -> WithErrors
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> (ProgramError -> NonEmpty ProgramError)
-> ProgramError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramError -> NonEmpty ProgramError
singleError (ProgramError -> IO UncheckedImport)
-> ProgramError -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$
                    Loc -> Doc -> ProgramError
ProgramError Loc
NoLoc (Doc -> ProgramError) -> Doc -> ProgramError
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 ::
  [LoadedFile (VNameSource, FileModule)] ->
  VNameSource ->
  [LoadedFile E.UncheckedProg] ->
  WithErrors (E.Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
typeCheckProg :: [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> WithErrors
     (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
typeCheckProg [LoadedFile (VNameSource, FileModule)]
orig_imports VNameSource
orig_src =
  ((Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
 -> LoadedFile UncheckedProg
 -> WithErrors
      (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource))
-> (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> [LoadedFile UncheckedProg]
-> WithErrors
     (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
-> WithErrors
     (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
-> WithErrors
     (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 (E.TypeError Loc
loc Notes
notes Doc
msg)) -> do
          let ws' :: Warnings
ws' = Warnings
ws Warnings -> Warnings -> Warnings
forall a. Semigroup a => a -> a -> a
<> Warnings
prog_ws
              err' :: Doc
err' = Doc
msg Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Notes -> Doc
forall a. Pretty a => a -> Doc
ppr Notes
notes
          NonEmpty ProgramError
-> WithErrors
     (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
forall a b. a -> Either a b
Left (NonEmpty ProgramError
 -> WithErrors
      (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource))
-> (Doc -> NonEmpty ProgramError)
-> Doc
-> WithErrors
     (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramError -> NonEmpty ProgramError
singleError (ProgramError -> NonEmpty ProgramError)
-> (Doc -> ProgramError) -> Doc -> NonEmpty ProgramError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> Doc -> ProgramError
ProgramError (Loc -> Loc
forall a. Located a => a -> Loc
locOf Loc
loc) (Doc
 -> WithErrors
      (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource))
-> Doc
-> WithErrors
     (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
<> Doc -> Doc
forall a. Pretty a => a -> Doc
ppr Doc
err'
              else Doc -> Doc
forall a. Pretty a => a -> Doc
ppr Doc
err'
        (Warnings
prog_ws, Right (FileModule
m, VNameSource
src')) ->
          (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> WithErrors
     (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
forall a b. b -> Either a b
Right
            ( 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 =
      -- We do not use ImportDec here, because we do not want the
      -- type checker to issue a warning about a redundant import.
      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

-- | 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 (VNameSource, FileModule)]
lpFiles :: [LoadedFile (VNameSource, FileModule)],
    -- | 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 = (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

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

-- | 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 -> [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

-- | Extend a loaded program with (possibly new) files.
extendProg ::
  LoadedProg ->
  [FilePath] ->
  IO (Either (NE.NonEmpty ProgramError) (E.Warnings, LoadedProg))
extendProg :: LoadedProg
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg))
extendProg LoadedProg
lp [FilePath]
new_roots = do
  Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
new_imports_untyped <-
    [ImportName]
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) [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
  Either (NonEmpty ProgramError) (Warnings, LoadedProg)
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (NonEmpty ProgramError) (Warnings, LoadedProg)
 -> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg)))
-> Either (NonEmpty ProgramError) (Warnings, LoadedProg)
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg))
forall a b. (a -> b) -> a -> b
$ do
    (Warnings
ws, [LoadedFile (VNameSource, FileModule)]
imports, VNameSource
src') <-
      [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> WithErrors
     (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
typeCheckProg (LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles LoadedProg
lp) (LoadedProg -> VNameSource
lpNameSource LoadedProg
lp) ([LoadedFile UncheckedProg]
 -> WithErrors
      (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource))
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> WithErrors
     (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
new_imports_untyped
    (Warnings, LoadedProg)
-> Either (NonEmpty ProgramError) (Warnings, LoadedProg)
forall a b. b -> Either a b
Right (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')

-- | 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] ->
  IO (Either (NE.NonEmpty ProgramError) (E.Warnings, LoadedProg))
reloadProg :: LoadedProg
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg))
reloadProg LoadedProg
lp [FilePath]
new_roots = do
  LoadedProg
lp' <- LoadedProg -> [FilePath] -> IO LoadedProg
forall (m :: * -> *).
MonadIO m =>
LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg LoadedProg
lp [FilePath]
new_roots
  LoadedProg
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg))
extendProg LoadedProg
lp' [FilePath]
new_roots

-- | 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 ProgramError) (E.Warnings, Imports, VNameSource))
readLibrary :: [Name]
-> [FilePath]
-> IO
     (Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource))
readLibrary [Name]
extra_eps [FilePath]
fps =
  ( ((Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
 -> (Warnings, Imports, VNameSource))
-> WithErrors
     (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> Either (NonEmpty ProgramError) (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
      (WithErrors
   (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
 -> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource))
-> ([LoadedFile UncheckedProg]
    -> WithErrors
         (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource))
-> [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> WithErrors
     (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
typeCheckProg [LoadedFile (VNameSource, FileModule)]
forall a. Monoid a => a
mempty (LoadedProg -> VNameSource
lpNameSource LoadedProg
noLoadedProg)
      ([LoadedFile UncheckedProg]
 -> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource))
-> (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
    -> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ([LoadedFile UncheckedProg] -> [LoadedFile UncheckedProg])
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Name]
-> [FilePath]
-> [LoadedFile UncheckedProg]
-> [LoadedFile UncheckedProg]
setEntryPoints (Name
E.defaultEntryPoint Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
extra_eps) [FilePath]
fps)
  )
    (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
 -> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource))
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> IO
     (Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportName]
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) [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)

-- | Read (and parse) all source files (including the builtin prelude)
-- corresponding to a set of root files.
readUntypedLibrary ::
  [FilePath] ->
  IO (Either (NE.NonEmpty ProgramError) [(ImportName, E.UncheckedProg)])
readUntypedLibrary :: [FilePath]
-> IO
     (Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)])
readUntypedLibrary = (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
 -> Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)])
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> IO
     (Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([LoadedFile UncheckedProg] -> [(ImportName, UncheckedProg)])
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) [(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)) (IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
 -> IO
      (Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)]))
-> ([FilePath]
    -> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]))
-> [FilePath]
-> IO
     (Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportName]
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) [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)