{-# 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,
    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 qualified Data.List.NonEmpty as NE
import Data.Loc (Loc (..), Located, 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, getCurrentTime)
import Futhark.FreshNames
import Futhark.Util (interactWithFileSafely, nubOrd, startupTime)
import Futhark.Util.Pretty (Doc, align, ppr, text)
import qualified Language.Futhark as E
import Language.Futhark.Parser (SyntaxError (..), parseFuthark)
import Language.Futhark.Prelude
import Language.Futhark.Prop (isBuiltin)
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 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 text 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 text 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 = 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 :: ProgError -> NE.NonEmpty ProgError
singleError :: ProgError -> NonEmpty ProgError
singleError = (ProgError -> [ProgError] -> NonEmpty ProgError
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 :: ProgError
problem =
                Loc -> Doc -> ProgError
ProgError (ImportName -> Loc
forall a. Located a => a -> Loc
locOf ImportName
include) (Doc -> ProgError) -> (FilePath -> Doc) -> FilePath -> ProgError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Doc
text (FilePath -> ProgError) -> FilePath -> ProgError
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 ProgError -> WithErrors (LoadedFile UncheckedProg)
forall a b. a -> Either a b
Left (ProgError -> NonEmpty ProgError
singleError ProgError
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 ProgError
errors ->
                  ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
 -> [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, NonEmpty ProgError -> WithErrors (LoadedFile UncheckedProg)
forall a b. a -> Either a b
Left NonEmpty ProgError
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 ProgError
x) : [(ImportName, WithErrors (LoadedFile UncheckedProg))]
rest) =
  (NonEmpty ProgError
 -> 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 ProgError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a b. a -> Either a b
Left (NonEmpty ProgError
 -> WithErrors [(ImportName, LoadedFile UncheckedProg)])
-> (NonEmpty ProgError -> NonEmpty ProgError)
-> NonEmpty ProgError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty ProgError
x NonEmpty ProgError -> NonEmpty ProgError -> NonEmpty ProgError
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 ProgError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
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) =
  ([(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

-- | 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 FilePath -> VFS -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
filepath VFS
vfs of
    Maybe Text
Nothing -> 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
    Just Text
file_contents -> do
      UTCTime
now <- IO UTCTime
getCurrentTime
      Maybe (Either FilePath (Text, UTCTime))
-> IO (Maybe (Either FilePath (Text, UTCTime)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either FilePath (Text, UTCTime))
 -> IO (Maybe (Either FilePath (Text, UTCTime))))
-> Maybe (Either FilePath (Text, UTCTime))
-> IO (Maybe (Either FilePath (Text, UTCTime)))
forall a b. (a -> b) -> a -> b
$ Either FilePath (Text, UTCTime)
-> Maybe (Either FilePath (Text, UTCTime))
forall a. a -> Maybe a
Just (Either FilePath (Text, UTCTime)
 -> Maybe (Either FilePath (Text, UTCTime)))
-> Either FilePath (Text, UTCTime)
-> Maybe (Either FilePath (Text, UTCTime))
forall a b. (a -> b) -> a -> b
$ (Text, UTCTime) -> Either FilePath (Text, UTCTime)
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, 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 ProgError (LoadedFile Text)
-> IO (Either ProgError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgError (LoadedFile Text)
 -> IO (Either ProgError (LoadedFile Text)))
-> Either ProgError (LoadedFile Text)
-> IO (Either ProgError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ LoadedFile Text -> Either ProgError (LoadedFile Text)
forall a b. b -> Either a b
Right (LoadedFile Text -> Either ProgError (LoadedFile Text))
-> LoadedFile Text -> Either ProgError (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 ProgError (LoadedFile Text)
-> IO (Either ProgError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgError (LoadedFile Text)
 -> IO (Either ProgError (LoadedFile Text)))
-> Either ProgError (LoadedFile Text)
-> IO (Either ProgError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ ProgError -> Either ProgError (LoadedFile Text)
forall a b. a -> Either a b
Left (ProgError -> Either ProgError (LoadedFile Text))
-> ProgError -> Either ProgError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ProgError
ProgError (ImportName -> Loc
forall a. Located a => a -> Loc
locOf ImportName
include) (Doc -> ProgError) -> Doc -> ProgError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
e
    (Maybe (Either FilePath (Text, UTCTime))
Nothing, Just Text
s) ->
      Either ProgError (LoadedFile Text)
-> IO (Either ProgError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgError (LoadedFile Text)
 -> IO (Either ProgError (LoadedFile Text)))
-> Either ProgError (LoadedFile Text)
-> IO (Either ProgError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ LoadedFile Text -> Either ProgError (LoadedFile Text)
forall a b. b -> Either a b
Right (LoadedFile Text -> Either ProgError (LoadedFile Text))
-> LoadedFile Text -> Either ProgError (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 ProgError (LoadedFile Text)
-> IO (Either ProgError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgError (LoadedFile Text)
 -> IO (Either ProgError (LoadedFile Text)))
-> Either ProgError (LoadedFile Text)
-> IO (Either ProgError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ ProgError -> Either ProgError (LoadedFile Text)
forall a b. a -> Either a b
Left (ProgError -> Either ProgError (LoadedFile Text))
-> ProgError -> Either ProgError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ProgError
ProgError (ImportName -> Loc
forall a. Located a => a -> Loc
locOf ImportName
include) (Doc -> ProgError) -> Doc -> ProgError
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 -> 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 FilePath
err) ->
      UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> (ProgError -> UncheckedImport)
-> ProgError
-> 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)
-> (ProgError
    -> WithErrors
         (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> ProgError
-> UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ProgError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgError
 -> WithErrors
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> (ProgError -> NonEmpty ProgError)
-> ProgError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgError -> NonEmpty ProgError
singleError (ProgError -> IO UncheckedImport)
-> ProgError -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ProgError
ProgError Loc
loc (Doc -> ProgError) -> Doc -> ProgError
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
-> VFS -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar VFS
vfs) [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 -> VFS -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport :: ReaderState
-> VFS -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar VFS
vfs 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 -> VFS -> IO (Either ProgError (LoadedFile Text))
readImportFile ImportName
include VFS
vfs IO (Either ProgError (LoadedFile Text))
-> (Either ProgError (LoadedFile Text) -> IO UncheckedImport)
-> IO UncheckedImport
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left ProgError
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 ProgError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgError
 -> WithErrors
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> NonEmpty ProgError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. (a -> b) -> a -> b
$ ProgError -> NonEmpty ProgError
singleError ProgError
e
            Right LoadedFile Text
file -> ReaderState -> VFS -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar VFS
vfs 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] ->
  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 <- 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
-> VFS -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar VFS
vfs 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 ProgError) [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 ProgError) [LoadedFile UncheckedProg])
-> ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
    -> WithErrors [(ImportName, LoadedFile UncheckedProg)])
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> Either (NonEmpty ProgError) [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 ProgError) [LoadedFile UncheckedProg])
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> IO (Either (NonEmpty ProgError) [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 -> 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 (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)
-> (ProgError -> UncheckedImport)
-> ProgError
-> 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)
-> (ProgError
    -> WithErrors
         (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> ProgError
-> UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ProgError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgError
 -> WithErrors
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> (ProgError -> NonEmpty ProgError)
-> ProgError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgError -> NonEmpty ProgError
singleError (ProgError -> IO UncheckedImport)
-> ProgError -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$
                    Loc -> Doc -> ProgError
ProgError Loc
NoLoc (Doc -> ProgError) -> Doc -> ProgError
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)
-> (ProgError -> UncheckedImport)
-> ProgError
-> 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)
-> (ProgError
    -> WithErrors
         (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> ProgError
-> UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ProgError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgError
 -> WithErrors
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> (ProgError -> NonEmpty ProgError)
-> ProgError
-> WithErrors
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgError -> NonEmpty ProgError
singleError (ProgError -> IO UncheckedImport)
-> ProgError -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$
                    Loc -> Doc -> ProgError
ProgError Loc
NoLoc (Doc -> ProgError) -> Doc -> ProgError
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

-- | 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 = (LoadedFile CheckedFile -> (FilePath, FileModule))
-> [LoadedFile CheckedFile] -> Imports
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 (LoadedFile CheckedFile -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile CheckedFile
lf), CheckedFile -> FileModule
cfMod (CheckedFile -> FileModule) -> CheckedFile -> FileModule
forall a b. (a -> b) -> a -> b
$ LoadedFile CheckedFile -> CheckedFile
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 =
  (([LoadedFile CheckedFile], VNameSource)
 -> LoadedFile UncheckedProg
 -> WithErrors ([LoadedFile CheckedFile], VNameSource))
-> ([LoadedFile CheckedFile], VNameSource)
-> [LoadedFile UncheckedProg]
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
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 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Notes -> Doc
forall a. Pretty a => a -> Doc
ppr Notes
notes
              warningToError :: (a, Doc) -> ProgError
warningToError (a
wloc, Doc
wmsg) = Loc -> Doc -> ProgError
ProgWarning (a -> Loc
forall a. Located a => a -> Loc
locOf a
wloc) Doc
wmsg
          NonEmpty ProgError
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
forall a b. a -> Either a b
Left (NonEmpty ProgError
 -> WithErrors ([LoadedFile CheckedFile], VNameSource))
-> NonEmpty ProgError
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
forall a b. (a -> b) -> a -> b
$
            Loc -> Doc -> ProgError
ProgError (Loc -> Loc
forall a. Located a => a -> Loc
locOf Loc
loc) Doc
err'
              ProgError -> [ProgError] -> NonEmpty ProgError
forall a. a -> [a] -> NonEmpty a
NE.:| ((SrcLoc, Doc) -> ProgError) -> [(SrcLoc, Doc)] -> [ProgError]
forall a b. (a -> b) -> [a] -> [b]
map (SrcLoc, Doc) -> ProgError
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 (a -> SrcLoc
forall a. Located a => a -> SrcLoc
E.srclocOf a
loc) (Doc -> Warnings) -> Doc -> Warnings
forall a b. (a -> b) -> a -> b
$ Doc
"Hole of type: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
align (a -> Doc
forall a. Pretty a => a -> Doc
ppr a
t)
              prog_ws' :: Warnings
prog_ws' = Warnings
prog_ws Warnings -> Warnings -> Warnings
forall a. Semigroup a => a -> a -> a
<> ((Loc, StructType) -> Warnings) -> [(Loc, StructType)] -> Warnings
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Loc, StructType) -> Warnings
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 ([LoadedFile CheckedFile], VNameSource)
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
forall a b. b -> Either a b
Right
                ( [LoadedFile CheckedFile]
imports [LoadedFile CheckedFile]
-> [LoadedFile CheckedFile] -> [LoadedFile CheckedFile]
forall a. [a] -> [a] -> [a]
++ [FilePath
-> ImportName -> CheckedFile -> UTCTime -> LoadedFile CheckedFile
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 = (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 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 = (LoadedFile CheckedFile -> (FilePath, FileModule))
-> [LoadedFile CheckedFile] -> Imports
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile CheckedFile -> (FilePath, FileModule)
f ([LoadedFile CheckedFile] -> Imports)
-> (LoadedProg -> [LoadedFile CheckedFile])
-> LoadedProg
-> Imports
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 (LoadedFile CheckedFile -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile CheckedFile
lf), CheckedFile -> FileModule
cfMod (CheckedFile -> FileModule) -> CheckedFile -> FileModule
forall a b. (a -> b) -> a -> b
$ LoadedFile CheckedFile -> CheckedFile
forall fm. LoadedFile fm -> fm
lfMod LoadedFile CheckedFile
lf)

-- | All warnings of a 'LoadedProg'.
lpWarnings :: LoadedProg -> Warnings
lpWarnings :: LoadedProg -> Warnings
lpWarnings = (LoadedFile CheckedFile -> Warnings)
-> [LoadedFile CheckedFile] -> Warnings
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CheckedFile -> Warnings
cfWarnings (CheckedFile -> Warnings)
-> (LoadedFile CheckedFile -> CheckedFile)
-> LoadedFile CheckedFile
-> Warnings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedFile CheckedFile -> CheckedFile
forall fm. LoadedFile fm -> fm
lfMod) ([LoadedFile CheckedFile] -> Warnings)
-> (LoadedProg -> [LoadedFile CheckedFile])
-> LoadedProg
-> Warnings
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 = (LoadedFile CheckedFile -> FilePath)
-> [LoadedFile CheckedFile] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile CheckedFile -> FilePath
forall fm. LoadedFile fm -> FilePath
lfPath ([LoadedFile CheckedFile] -> [FilePath])
-> (LoadedProg -> [LoadedFile CheckedFile])
-> LoadedProg
-> [FilePath]
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 :: VNameSource
-> VFS
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
unchangedImports VNameSource
src VFS
_ [] = ([LoadedFile CheckedFile], VNameSource)
-> m ([LoadedFile CheckedFile], VNameSource)
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 (LoadedFile CheckedFile -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile CheckedFile
f)) =
      ([LoadedFile CheckedFile] -> [LoadedFile CheckedFile])
-> ([LoadedFile CheckedFile], VNameSource)
-> ([LoadedFile CheckedFile], VNameSource)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (LoadedFile CheckedFile
f LoadedFile CheckedFile
-> [LoadedFile CheckedFile] -> [LoadedFile CheckedFile]
forall a. a -> [a] -> [a]
:) (([LoadedFile CheckedFile], VNameSource)
 -> ([LoadedFile CheckedFile], VNameSource))
-> m ([LoadedFile CheckedFile], VNameSource)
-> m ([LoadedFile CheckedFile], VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VNameSource
-> VFS
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
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 = LoadedFile CheckedFile -> FilePath
forall fm. LoadedFile fm -> FilePath
lfPath LoadedFile CheckedFile
f
      if FilePath -> VFS -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member FilePath
file_path VFS
vfs
        then ([LoadedFile CheckedFile], VNameSource)
-> m ([LoadedFile CheckedFile], VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], CheckedFile -> VNameSource
cfNameSource (CheckedFile -> VNameSource) -> CheckedFile -> VNameSource
forall a b. (a -> b) -> a -> b
$ LoadedFile CheckedFile -> CheckedFile
forall fm. LoadedFile fm -> fm
lfMod LoadedFile CheckedFile
f)
        else 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 CheckedFile -> UTCTime
forall fm. LoadedFile fm -> UTCTime
lfModTime LoadedFile CheckedFile
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
file_path))
          if Bool
changed
            then ([LoadedFile CheckedFile], VNameSource)
-> m ([LoadedFile CheckedFile], VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], CheckedFile -> VNameSource
cfNameSource (CheckedFile -> VNameSource) -> CheckedFile -> VNameSource
forall a b. (a -> b) -> a -> b
$ LoadedFile CheckedFile -> CheckedFile
forall fm. LoadedFile fm -> fm
lfMod LoadedFile CheckedFile
f)
            else ([LoadedFile CheckedFile] -> [LoadedFile CheckedFile])
-> ([LoadedFile CheckedFile], VNameSource)
-> ([LoadedFile CheckedFile], VNameSource)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (LoadedFile CheckedFile
f LoadedFile CheckedFile
-> [LoadedFile CheckedFile] -> [LoadedFile CheckedFile]
forall a. a -> [a] -> [a]
:) (([LoadedFile CheckedFile], VNameSource)
 -> ([LoadedFile CheckedFile], VNameSource))
-> m ([LoadedFile CheckedFile], VNameSource)
-> m ([LoadedFile CheckedFile], VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VNameSource
-> VFS
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
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 :: [FilePath] -> [LoadedFile CheckedFile] -> VNameSource -> LoadedProg
LoadedProg
    { lpRoots :: [FilePath]
lpRoots = [],
      lpFiles :: [LoadedFile CheckedFile]
lpFiles = [LoadedFile CheckedFile]
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 -> VFS -> [FilePath] -> m LoadedProg
usableLoadedProg :: LoadedProg -> VFS -> [FilePath] -> m LoadedProg
usableLoadedProg (LoadedProg [FilePath]
roots [LoadedFile CheckedFile]
imports VNameSource
src) VFS
vfs [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 CheckedFile]
imports', VNameSource
src') <- VNameSource
-> VFS
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> VFS
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
unchangedImports VNameSource
src VFS
vfs [LoadedFile CheckedFile]
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 CheckedFile] -> VNameSource -> LoadedProg
LoadedProg [] [LoadedFile CheckedFile]
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] ->
  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 ((LoadedFile CheckedFile -> ImportName)
-> [LoadedFile CheckedFile] -> [ImportName]
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile CheckedFile -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName ([LoadedFile CheckedFile] -> [ImportName])
-> [LoadedFile CheckedFile] -> [ImportName]
forall a b. (a -> b) -> a -> b
$ LoadedProg -> [LoadedFile CheckedFile]
lpFiles LoadedProg
lp) VFS
vfs [FilePath]
new_roots
  Either (NonEmpty ProgError) LoadedProg
-> IO (Either (NonEmpty ProgError) LoadedProg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (NonEmpty ProgError) LoadedProg
 -> IO (Either (NonEmpty ProgError) LoadedProg))
-> Either (NonEmpty ProgError) LoadedProg
-> IO (Either (NonEmpty ProgError) LoadedProg)
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) ([LoadedFile UncheckedProg]
 -> WithErrors ([LoadedFile CheckedFile], VNameSource))
-> Either (NonEmpty ProgError) [LoadedFile UncheckedProg]
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either (NonEmpty ProgError) [LoadedFile UncheckedProg]
new_imports_untyped
    LoadedProg -> Either (NonEmpty ProgError) LoadedProg
forall a b. b -> Either a b
Right ([FilePath] -> [LoadedFile CheckedFile] -> 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 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' <- LoadedProg -> VFS -> [FilePath] -> IO LoadedProg
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 =
  ( (([LoadedFile CheckedFile], VNameSource)
 -> (Warnings, Imports, VNameSource))
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
-> Either (NonEmpty ProgError) (Warnings, Imports, VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([LoadedFile CheckedFile], VNameSource)
-> (Warnings, Imports, VNameSource)
forall c. ([LoadedFile CheckedFile], c) -> (Warnings, Imports, c)
frob
      (WithErrors ([LoadedFile CheckedFile], VNameSource)
 -> Either (NonEmpty ProgError) (Warnings, Imports, VNameSource))
-> ([LoadedFile UncheckedProg]
    -> WithErrors ([LoadedFile CheckedFile], VNameSource))
-> [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgError) (Warnings, Imports, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LoadedFile CheckedFile]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
typeCheckProg [LoadedFile CheckedFile]
forall a. Monoid a => a
mempty (LoadedProg -> VNameSource
lpNameSource LoadedProg
noLoadedProg)
      ([LoadedFile UncheckedProg]
 -> Either (NonEmpty ProgError) (Warnings, Imports, VNameSource))
-> (Either (NonEmpty ProgError) [LoadedFile UncheckedProg]
    -> Either (NonEmpty ProgError) [LoadedFile UncheckedProg])
-> Either (NonEmpty ProgError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgError) (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 ProgError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgError) [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 ProgError) [LoadedFile UncheckedProg]
 -> Either (NonEmpty ProgError) (Warnings, Imports, VNameSource))
-> IO (Either (NonEmpty ProgError) [LoadedFile UncheckedProg])
-> IO
     (Either (NonEmpty ProgError) (Warnings, Imports, VNameSource))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportName]
-> VFS
-> [FilePath]
-> IO (Either (NonEmpty ProgError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown [] VFS
forall k a. Map k a
M.empty [FilePath]
fps
  where
    frob :: ([LoadedFile CheckedFile], c) -> (Warnings, Imports, c)
frob ([LoadedFile CheckedFile]
y, c
z) = ((LoadedFile CheckedFile -> Warnings)
-> [LoadedFile CheckedFile] -> Warnings
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CheckedFile -> Warnings
cfWarnings (CheckedFile -> Warnings)
-> (LoadedFile CheckedFile -> CheckedFile)
-> LoadedFile CheckedFile
-> Warnings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedFile CheckedFile -> CheckedFile
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 = (Either (NonEmpty ProgError) [LoadedFile UncheckedProg]
 -> Either (NonEmpty ProgError) [(ImportName, UncheckedProg)])
-> IO (Either (NonEmpty ProgError) [LoadedFile UncheckedProg])
-> IO (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([LoadedFile UncheckedProg] -> [(ImportName, UncheckedProg)])
-> Either (NonEmpty ProgError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgError) [(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 ProgError) [LoadedFile UncheckedProg])
 -> IO (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)]))
-> ([FilePath]
    -> IO (Either (NonEmpty ProgError) [LoadedFile UncheckedProg]))
-> [FilePath]
-> IO (Either (NonEmpty ProgError) [(ImportName, UncheckedProg)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportName]
-> VFS
-> [FilePath]
-> IO (Either (NonEmpty ProgError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown [] VFS
forall k a. Map k a
M.empty
  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)