{-# 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,
    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, 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, getCurrentTime)
import Futhark.FreshNames
import Futhark.Util (interactWithFileSafely, nubOrd, startupTime)
import Futhark.Util.Pretty (Doc, align, line, 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

type WithErrors = Either (NE.NonEmpty ProgError)

-- | 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
          NonEmpty ProgError
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
forall a b. a -> Either a b
Left (NonEmpty ProgError
 -> WithErrors ([LoadedFile CheckedFile], VNameSource))
-> (Doc -> NonEmpty ProgError)
-> Doc
-> WithErrors ([LoadedFile CheckedFile], VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgError -> NonEmpty ProgError
singleError (ProgError -> NonEmpty ProgError)
-> (Doc -> ProgError) -> Doc -> NonEmpty ProgError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> Doc -> ProgError
ProgError (Loc -> Loc
forall a. Located a => a -> Loc
locOf Loc
loc) (Doc -> WithErrors ([LoadedFile CheckedFile], VNameSource))
-> Doc -> WithErrors ([LoadedFile CheckedFile], VNameSource)
forall a b. (a -> b) -> a -> b
$
            if Warnings -> Bool
anyWarnings Warnings
prog_ws
              then Warnings -> Doc
forall a. Pretty a => a -> Doc
ppr Warnings
prog_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')) ->
          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

unchangedImports ::
  MonadIO m =>
  VNameSource ->
  [LoadedFile CheckedFile] ->
  m ([LoadedFile CheckedFile], VNameSource)
unchangedImports :: VNameSource
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
unchangedImports VNameSource
src [] = ([LoadedFile CheckedFile], VNameSource)
-> m ([LoadedFile CheckedFile], VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], VNameSource
src)
unchangedImports VNameSource
src (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
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
unchangedImports VNameSource
src [LoadedFile CheckedFile]
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 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 -> IO UTCTime) -> FilePath -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ LoadedFile CheckedFile -> FilePath
forall fm. LoadedFile fm -> FilePath
lfPath LoadedFile CheckedFile
f))
      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
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
unchangedImports VNameSource
src [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 -> [FilePath] -> m LoadedProg
usableLoadedProg :: LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg (LoadedProg [FilePath]
roots [LoadedFile CheckedFile]
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 CheckedFile]
imports', VNameSource
src') <- VNameSource
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile CheckedFile]
-> m ([LoadedFile CheckedFile], VNameSource)
unchangedImports VNameSource
src [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 -> [FilePath] -> IO LoadedProg
forall (m :: * -> *).
MonadIO m =>
LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg LoadedProg
lp [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)