{-# 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,
    LoadedProg (lpNameSource),
    noLoadedProg,
    lpImports,
    reloadProg,
    extendProg,
  )
where

import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
  ( MVar,
    modifyMVar,
    newEmptyMVar,
    newMVar,
    putMVar,
    readMVar,
  )
import Control.Monad
import Control.Monad.Except
import Control.Monad.State (execStateT, gets, modify)
import Data.Bifunctor (first)
import Data.List (intercalate, isPrefixOf, sort)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time.Clock (UTCTime)
import Futhark.Error
import Futhark.FreshNames
import Futhark.Util (interactWithFileSafely, nubOrd, startupTime)
import Futhark.Util.Pretty (line, ppr, text, (</>))
import qualified Language.Futhark as E
import Language.Futhark.Parser
import Language.Futhark.Prelude
import Language.Futhark.Semantic
import qualified Language.Futhark.TypeChecker as E
import Language.Futhark.Warnings
import System.Directory (getModificationTime)
import System.FilePath (normalise)
import qualified System.FilePath.Posix as Posix

data LoadedFile fm = LoadedFile
  { LoadedFile fm -> FilePath
lfPath :: FilePath,
    LoadedFile fm -> ImportName
lfImportName :: ImportName,
    LoadedFile fm -> fm
lfMod :: fm,
    -- | Modification time of the underlying file.
    LoadedFile fm -> UTCTime
lfModTime :: UTCTime
  }
  deriving (LoadedFile fm -> LoadedFile fm -> Bool
(LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool) -> Eq (LoadedFile fm)
forall fm. Eq fm => LoadedFile fm -> LoadedFile fm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoadedFile fm -> LoadedFile fm -> Bool
$c/= :: forall fm. Eq fm => LoadedFile fm -> LoadedFile fm -> Bool
== :: LoadedFile fm -> LoadedFile fm -> Bool
$c== :: forall fm. Eq fm => LoadedFile fm -> LoadedFile fm -> Bool
Eq, Eq (LoadedFile fm)
Eq (LoadedFile fm)
-> (LoadedFile fm -> LoadedFile fm -> Ordering)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> LoadedFile fm)
-> (LoadedFile fm -> LoadedFile fm -> LoadedFile fm)
-> Ord (LoadedFile fm)
LoadedFile fm -> LoadedFile fm -> Bool
LoadedFile fm -> LoadedFile fm -> Ordering
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall fm. Ord fm => Eq (LoadedFile fm)
forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Ordering
forall fm.
Ord fm =>
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
min :: LoadedFile fm -> LoadedFile fm -> LoadedFile fm
$cmin :: forall fm.
Ord fm =>
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
max :: LoadedFile fm -> LoadedFile fm -> LoadedFile fm
$cmax :: forall fm.
Ord fm =>
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
>= :: LoadedFile fm -> LoadedFile fm -> Bool
$c>= :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
> :: LoadedFile fm -> LoadedFile fm -> Bool
$c> :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
<= :: LoadedFile fm -> LoadedFile fm -> Bool
$c<= :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
< :: LoadedFile fm -> LoadedFile fm -> Bool
$c< :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
compare :: LoadedFile fm -> LoadedFile fm -> Ordering
$ccompare :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Ordering
$cp1Ord :: forall fm. Ord fm => Eq (LoadedFile fm)
Ord, Int -> LoadedFile fm -> ShowS
[LoadedFile fm] -> ShowS
LoadedFile fm -> FilePath
(Int -> LoadedFile fm -> ShowS)
-> (LoadedFile fm -> FilePath)
-> ([LoadedFile fm] -> ShowS)
-> Show (LoadedFile fm)
forall fm. Show fm => Int -> LoadedFile fm -> ShowS
forall fm. Show fm => [LoadedFile fm] -> ShowS
forall fm. Show fm => LoadedFile fm -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LoadedFile fm] -> ShowS
$cshowList :: forall fm. Show fm => [LoadedFile fm] -> ShowS
show :: LoadedFile fm -> FilePath
$cshow :: forall fm. Show fm => LoadedFile fm -> FilePath
showsPrec :: Int -> LoadedFile fm -> ShowS
$cshowsPrec :: forall fm. Show fm => Int -> LoadedFile fm -> ShowS
Show)

newtype UncheckedImport = UncheckedImport
  { UncheckedImport
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
unChecked ::
      Either CompilerError (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

orderedImports ::
  (MonadError CompilerError m, MonadIO m) =>
  [(ImportName, MVar UncheckedImport)] ->
  m [(ImportName, LoadedFile E.UncheckedProg)]
orderedImports :: [(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)]
orderedImports = ([(ImportName, LoadedFile UncheckedProg)]
 -> [(ImportName, LoadedFile UncheckedProg)])
-> m [(ImportName, LoadedFile UncheckedProg)]
-> m [(ImportName, LoadedFile UncheckedProg)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)]
forall a. [a] -> [a]
reverse (m [(ImportName, LoadedFile UncheckedProg)]
 -> m [(ImportName, LoadedFile UncheckedProg)])
-> ([(ImportName, MVar UncheckedImport)]
    -> m [(ImportName, LoadedFile UncheckedProg)])
-> [(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT [(ImportName, LoadedFile UncheckedProg)] m ()
 -> [(ImportName, LoadedFile UncheckedProg)]
 -> m [(ImportName, LoadedFile UncheckedProg)])
-> [(ImportName, LoadedFile UncheckedProg)]
-> StateT [(ImportName, LoadedFile UncheckedProg)] m ()
-> m [(ImportName, LoadedFile UncheckedProg)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [(ImportName, LoadedFile UncheckedProg)] m ()
-> [(ImportName, LoadedFile UncheckedProg)]
-> m [(ImportName, LoadedFile UncheckedProg)]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT [] (StateT [(ImportName, LoadedFile UncheckedProg)] m ()
 -> m [(ImportName, LoadedFile UncheckedProg)])
-> ([(ImportName, MVar UncheckedImport)]
    -> StateT [(ImportName, LoadedFile UncheckedProg)] m ())
-> [(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ImportName, MVar UncheckedImport)
 -> StateT [(ImportName, LoadedFile UncheckedProg)] m ())
-> [(ImportName, MVar UncheckedImport)]
-> StateT [(ImportName, LoadedFile UncheckedProg)] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ImportName]
-> (ImportName, MVar UncheckedImport)
-> StateT [(ImportName, LoadedFile UncheckedProg)] m ()
forall (m :: * -> *).
(MonadState [(ImportName, LoadedFile UncheckedProg)] m, MonadIO m,
 MonadError CompilerError 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 =
        FilePath -> m ()
forall (m :: * -> *) a.
MonadError CompilerError m =>
FilePath -> m a
externalErrorS (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$
          FilePath
"Import cycle: "
            FilePath -> ShowS
forall 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)
      | Bool
otherwise = do
        Maybe (LoadedFile UncheckedProg)
prev <- ([(ImportName, LoadedFile UncheckedProg)]
 -> Maybe (LoadedFile UncheckedProg))
-> m (Maybe (LoadedFile UncheckedProg))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (([(ImportName, LoadedFile UncheckedProg)]
  -> Maybe (LoadedFile UncheckedProg))
 -> m (Maybe (LoadedFile UncheckedProg)))
-> ([(ImportName, LoadedFile UncheckedProg)]
    -> Maybe (LoadedFile UncheckedProg))
-> m (Maybe (LoadedFile UncheckedProg))
forall a b. (a -> b) -> a -> b
$ ImportName
-> [(ImportName, LoadedFile UncheckedProg)]
-> Maybe (LoadedFile UncheckedProg)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ImportName
include
        case Maybe (LoadedFile UncheckedProg)
prev of
          Just LoadedFile UncheckedProg
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Maybe (LoadedFile UncheckedProg)
Nothing -> do
            (LoadedFile UncheckedProg
file, [(ImportName, MVar UncheckedImport)]
more_imports) <-
              (CompilerError
 -> m (LoadedFile UncheckedProg,
       [(ImportName, MVar UncheckedImport)]))
-> ((LoadedFile UncheckedProg,
     [(ImportName, MVar UncheckedImport)])
    -> m (LoadedFile UncheckedProg,
          [(ImportName, MVar UncheckedImport)]))
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> m (LoadedFile UncheckedProg,
      [(ImportName, MVar UncheckedImport)])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CompilerError
-> m (LoadedFile UncheckedProg,
      [(ImportName, MVar UncheckedImport)])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> m (LoadedFile UncheckedProg,
      [(ImportName, MVar UncheckedImport)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   CompilerError
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> m (LoadedFile UncheckedProg,
       [(ImportName, MVar UncheckedImport)]))
-> (UncheckedImport
    -> Either
         CompilerError
         (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> UncheckedImport
-> m (LoadedFile UncheckedProg,
      [(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UncheckedImport
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
unChecked (UncheckedImport
 -> m (LoadedFile UncheckedProg,
       [(ImportName, MVar UncheckedImport)]))
-> m UncheckedImport
-> m (LoadedFile UncheckedProg,
      [(ImportName, MVar UncheckedImport)])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m 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)
            ((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, LoadedFile UncheckedProg)]
 -> [(ImportName, LoadedFile UncheckedProg)])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, LoadedFile UncheckedProg
file) (ImportName, LoadedFile UncheckedProg)
-> [(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)]
forall a. a -> [a] -> [a]
:)

newImportMVar :: IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar :: IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar IO UncheckedImport
m = do
  MVar UncheckedImport
mvar <- IO (MVar UncheckedImport)
forall a. IO (MVar a)
newEmptyMVar
  IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ MVar UncheckedImport -> UncheckedImport -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar UncheckedImport
mvar (UncheckedImport -> IO ()) -> IO UncheckedImport -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UncheckedImport
m
  Maybe (MVar UncheckedImport) -> IO (Maybe (MVar UncheckedImport))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (MVar UncheckedImport) -> IO (Maybe (MVar UncheckedImport)))
-> Maybe (MVar UncheckedImport)
-> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ MVar UncheckedImport -> Maybe (MVar UncheckedImport)
forall a. a -> Maybe a
Just MVar UncheckedImport
mvar

contentsAndModTime :: FilePath -> IO (Maybe (Either String (T.Text, UTCTime)))
contentsAndModTime :: FilePath -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
filepath =
  IO (Text, UTCTime) -> IO (Maybe (Either FilePath (Text, UTCTime)))
forall a. IO a -> IO (Maybe (Either FilePath a))
interactWithFileSafely (IO (Text, UTCTime)
 -> IO (Maybe (Either FilePath (Text, UTCTime))))
-> IO (Text, UTCTime)
-> IO (Maybe (Either FilePath (Text, UTCTime)))
forall a b. (a -> b) -> a -> b
$
    (,) (Text -> UTCTime -> (Text, UTCTime))
-> IO Text -> IO (UTCTime -> (Text, UTCTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
T.readFile FilePath
filepath IO (UTCTime -> (Text, UTCTime)) -> IO UTCTime -> IO (Text, UTCTime)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO UTCTime
getModificationTime FilePath
filepath

readImportFile :: ImportName -> IO (Either CompilerError (LoadedFile T.Text))
readImportFile :: ImportName -> IO (Either CompilerError (LoadedFile Text))
readImportFile ImportName
include = do
  -- First we try to find a file of the given name in the search path,
  -- then we look at the builtin library if we have to.  For the
  -- builtins, we don't use the search path.
  let filepath :: FilePath
filepath = ImportName -> FilePath
includeToFilePath ImportName
include
  Maybe (Either FilePath (Text, UTCTime))
r <- FilePath -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
filepath
  case (Maybe (Either FilePath (Text, UTCTime))
r, FilePath -> [(FilePath, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
prelude_str [(FilePath, Text)]
prelude) of
    (Just (Right (Text
s, UTCTime
mod_time)), Maybe Text
_) ->
      Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CompilerError (LoadedFile Text)
 -> IO (Either CompilerError (LoadedFile Text)))
-> Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ LoadedFile Text -> Either CompilerError (LoadedFile Text)
forall a b. b -> Either a b
Right (LoadedFile Text -> Either CompilerError (LoadedFile Text))
-> LoadedFile Text -> Either CompilerError (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 CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CompilerError (LoadedFile Text)
 -> IO (Either CompilerError (LoadedFile Text)))
-> Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ CompilerError -> Either CompilerError (LoadedFile Text)
forall a b. a -> Either a b
Left (CompilerError -> Either CompilerError (LoadedFile Text))
-> CompilerError -> Either CompilerError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ Doc -> CompilerError
ExternalError (Doc -> CompilerError) -> Doc -> CompilerError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
e
    (Maybe (Either FilePath (Text, UTCTime))
Nothing, Just Text
s) ->
      Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CompilerError (LoadedFile Text)
 -> IO (Either CompilerError (LoadedFile Text)))
-> Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ LoadedFile Text -> Either CompilerError (LoadedFile Text)
forall a b. b -> Either a b
Right (LoadedFile Text -> Either CompilerError (LoadedFile Text))
-> LoadedFile Text -> Either CompilerError (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 CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CompilerError (LoadedFile Text)
 -> IO (Either CompilerError (LoadedFile Text)))
-> Either CompilerError (LoadedFile Text)
-> IO (Either CompilerError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ CompilerError -> Either CompilerError (LoadedFile Text)
forall a b. a -> Either a b
Left (CompilerError -> Either CompilerError (LoadedFile Text))
-> CompilerError -> Either CompilerError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ Doc -> CompilerError
ExternalError (Doc -> CompilerError) -> Doc -> CompilerError
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
"Error at " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> FilePath
forall a. Located a => a -> FilePath
E.locStr (ImportName -> SrcLoc
forall a. Located a => a -> SrcLoc
E.srclocOf ImportName
include)
        FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": could not find import '"
        FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ImportName -> FilePath
includeToString ImportName
include
        FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'."

handleFile ::
  ReaderState -> LoadedFile T.Text -> IO UncheckedImport
handleFile :: ReaderState -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar (LoadedFile FilePath
file_name ImportName
import_name Text
file_contents UTCTime
mod_time) = do
  case FilePath -> Text -> Either ParseError UncheckedProg
parseFuthark FilePath
file_name Text
file_contents of
    Left ParseError
err -> 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
$ Either
  CompilerError
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (Either
   CompilerError
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> UncheckedImport)
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ CompilerError
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (CompilerError
 -> Either
      CompilerError
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> CompilerError
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. (a -> b) -> a -> b
$ Doc -> CompilerError
ExternalError (Doc -> CompilerError) -> Doc -> CompilerError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err
    Right UncheckedProg
prog -> do
      let imports :: [ImportName]
imports = ((FilePath, SrcLoc) -> ImportName)
-> [(FilePath, SrcLoc)] -> [ImportName]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> SrcLoc -> ImportName)
-> (FilePath, SrcLoc) -> ImportName
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ImportName -> FilePath -> SrcLoc -> ImportName
mkImportFrom ImportName
import_name)) ([(FilePath, SrcLoc)] -> [ImportName])
-> [(FilePath, SrcLoc)] -> [ImportName]
forall a b. (a -> b) -> a -> b
$ UncheckedProg -> [(FilePath, SrcLoc)]
forall (f :: * -> *) vn. ProgBase f vn -> [(FilePath, SrcLoc)]
E.progImports UncheckedProg
prog
      [(ImportName, MVar UncheckedImport)]
mvars <-
        ((ImportName, Maybe (MVar UncheckedImport))
 -> Maybe (ImportName, MVar UncheckedImport))
-> [(ImportName, Maybe (MVar UncheckedImport))]
-> [(ImportName, MVar UncheckedImport)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportName, Maybe (MVar UncheckedImport))
-> Maybe (ImportName, MVar UncheckedImport)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([(ImportName, Maybe (MVar UncheckedImport))]
 -> [(ImportName, MVar UncheckedImport)])
-> ([Maybe (MVar UncheckedImport)]
    -> [(ImportName, Maybe (MVar UncheckedImport))])
-> [Maybe (MVar UncheckedImport)]
-> [(ImportName, MVar UncheckedImport)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportName]
-> [Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ImportName]
imports
          ([Maybe (MVar UncheckedImport)]
 -> [(ImportName, MVar UncheckedImport)])
-> IO [Maybe (MVar UncheckedImport)]
-> IO [(ImportName, MVar UncheckedImport)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImportName -> IO (Maybe (MVar UncheckedImport)))
-> [ImportName] -> IO [Maybe (MVar UncheckedImport)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar) [ImportName]
imports
      let file :: LoadedFile UncheckedProg
file =
            LoadedFile :: forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile
              { lfPath :: FilePath
lfPath = FilePath
file_name,
                lfImportName :: ImportName
lfImportName = ImportName
import_name,
                lfModTime :: UTCTime
lfModTime = UTCTime
mod_time,
                lfMod :: UncheckedProg
lfMod = UncheckedProg
prog
              }
      UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> UncheckedImport -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Either
  CompilerError
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (Either
   CompilerError
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> UncheckedImport)
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. b -> Either a b
Right (LoadedFile UncheckedProg
file, [(ImportName, MVar UncheckedImport)]
mvars)

readImport :: ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport :: ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar ImportName
include =
  ReaderState
-> (Map ImportName (Maybe (MVar UncheckedImport))
    -> IO
         (Map ImportName (Maybe (MVar UncheckedImport)),
          Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar ReaderState
state_mvar ((Map ImportName (Maybe (MVar UncheckedImport))
  -> IO
       (Map ImportName (Maybe (MVar UncheckedImport)),
        Maybe (MVar UncheckedImport)))
 -> IO (Maybe (MVar UncheckedImport)))
-> (Map ImportName (Maybe (MVar UncheckedImport))
    -> IO
         (Map ImportName (Maybe (MVar UncheckedImport)),
          Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ \Map ImportName (Maybe (MVar UncheckedImport))
state ->
    case ImportName
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Maybe (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ImportName
include Map ImportName (Maybe (MVar UncheckedImport))
state of
      Just Maybe (MVar UncheckedImport)
x -> (Map ImportName (Maybe (MVar UncheckedImport)),
 Maybe (MVar UncheckedImport))
-> IO
     (Map ImportName (Maybe (MVar UncheckedImport)),
      Maybe (MVar UncheckedImport))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ImportName (Maybe (MVar UncheckedImport))
state, Maybe (MVar UncheckedImport)
x)
      Maybe (Maybe (MVar UncheckedImport))
Nothing -> do
        Maybe (MVar UncheckedImport)
prog_mvar <- IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar (IO UncheckedImport -> IO (Maybe (MVar UncheckedImport)))
-> IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ do
          ImportName -> IO (Either CompilerError (LoadedFile Text))
readImportFile ImportName
include IO (Either CompilerError (LoadedFile Text))
-> (Either CompilerError (LoadedFile Text) -> IO UncheckedImport)
-> IO UncheckedImport
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left CompilerError
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
$ Either
  CompilerError
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (Either
   CompilerError
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> UncheckedImport)
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ CompilerError
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left CompilerError
e
            Right LoadedFile Text
file -> ReaderState -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar LoadedFile Text
file
        (Map ImportName (Maybe (MVar UncheckedImport)),
 Maybe (MVar UncheckedImport))
-> IO
     (Map ImportName (Maybe (MVar UncheckedImport)),
      Maybe (MVar UncheckedImport))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImportName
-> Maybe (MVar UncheckedImport)
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Map ImportName (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ImportName
include Maybe (MVar UncheckedImport)
prog_mvar Map ImportName (Maybe (MVar UncheckedImport))
state, Maybe (MVar UncheckedImport)
prog_mvar)

readUntypedLibraryExceptKnown ::
  (MonadIO m, MonadError CompilerError m) =>
  [ImportName] ->
  [FilePath] ->
  m [LoadedFile E.UncheckedProg]
readUntypedLibraryExceptKnown :: [ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
readUntypedLibraryExceptKnown [ImportName]
known [FilePath]
fps = do
  ReaderState
state_mvar <- IO ReaderState -> m ReaderState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReaderState -> m ReaderState)
-> IO ReaderState -> m 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))
-> m (Maybe (MVar UncheckedImport))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (MVar UncheckedImport))
 -> m (Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport))
-> m (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar ImportName
prelude_import
  [(ImportName, Maybe (MVar UncheckedImport))]
fps_mvars <- IO [(ImportName, Maybe (MVar UncheckedImport))]
-> m [(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)
-> [(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 ([(ImportName, LoadedFile UncheckedProg)]
 -> [LoadedFile UncheckedProg])
-> m [(ImportName, LoadedFile UncheckedProg)]
-> m [LoadedFile UncheckedProg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)]
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[(ImportName, MVar UncheckedImport)]
-> m [(ImportName, LoadedFile UncheckedProg)]
orderedImports [(ImportName, MVar UncheckedImport)]
unknown_mvars
  where
    onlyUnknown :: [(ImportName, Maybe a)] -> [(ImportName, a)]
onlyUnknown = ((ImportName, Maybe a) -> Maybe (ImportName, a))
-> [(ImportName, Maybe a)] -> [(ImportName, a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportName, Maybe a) -> Maybe (ImportName, a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
    onFile :: ReaderState
-> FilePath -> IO (ImportName, Maybe (MVar UncheckedImport))
onFile ReaderState
state_mvar FilePath
fp =
      ReaderState
-> (Map ImportName (Maybe (MVar UncheckedImport))
    -> IO
         (Map ImportName (Maybe (MVar UncheckedImport)),
          (ImportName, Maybe (MVar UncheckedImport))))
-> IO (ImportName, Maybe (MVar UncheckedImport))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar ReaderState
state_mvar ((Map ImportName (Maybe (MVar UncheckedImport))
  -> IO
       (Map ImportName (Maybe (MVar UncheckedImport)),
        (ImportName, Maybe (MVar UncheckedImport))))
 -> IO (ImportName, Maybe (MVar UncheckedImport)))
-> (Map ImportName (Maybe (MVar UncheckedImport))
    -> IO
         (Map ImportName (Maybe (MVar UncheckedImport)),
          (ImportName, Maybe (MVar UncheckedImport))))
-> IO (ImportName, Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ \Map ImportName (Maybe (MVar UncheckedImport))
state -> do
        case ImportName
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Maybe (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ImportName
include Map ImportName (Maybe (MVar UncheckedImport))
state of
          Just Maybe (MVar UncheckedImport)
prog_mvar -> (Map ImportName (Maybe (MVar UncheckedImport)),
 (ImportName, Maybe (MVar UncheckedImport)))
-> IO
     (Map ImportName (Maybe (MVar UncheckedImport)),
      (ImportName, Maybe (MVar UncheckedImport)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ImportName (Maybe (MVar UncheckedImport))
state, (ImportName
include, Maybe (MVar UncheckedImport)
prog_mvar))
          Maybe (Maybe (MVar UncheckedImport))
Nothing -> do
            Maybe (MVar UncheckedImport)
prog_mvar <- IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar (IO UncheckedImport -> IO (Maybe (MVar UncheckedImport)))
-> IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ do
              Maybe (Either FilePath (Text, UTCTime))
r <- FilePath -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
fp
              case Maybe (Either FilePath (Text, UTCTime))
r of
                Just (Right (Text
fs, UTCTime
mod_time)) -> do
                  ReaderState -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar (LoadedFile Text -> IO UncheckedImport)
-> LoadedFile Text -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$
                    LoadedFile :: forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile
                      { lfImportName :: ImportName
lfImportName = ImportName
include,
                        lfMod :: Text
lfMod = Text
fs,
                        lfModTime :: UTCTime
lfModTime = UTCTime
mod_time,
                        lfPath :: FilePath
lfPath = FilePath
fp
                      }
                Just (Left FilePath
e) ->
                  UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> UncheckedImport -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Either
  CompilerError
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (Either
   CompilerError
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> UncheckedImport)
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ CompilerError
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (CompilerError
 -> Either
      CompilerError
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> CompilerError
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. (a -> b) -> a -> b
$ Doc -> CompilerError
ExternalError (Doc -> CompilerError) -> Doc -> CompilerError
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)
-> UncheckedImport -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Either
  CompilerError
  (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (Either
   CompilerError
   (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
 -> UncheckedImport)
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ CompilerError
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (CompilerError
 -> Either
      CompilerError
      (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> CompilerError
-> Either
     CompilerError
     (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. (a -> b) -> a -> b
$ Doc -> CompilerError
ExternalError (Doc -> CompilerError) -> Doc -> CompilerError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ FilePath
fp FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
": file not found."
            (Map ImportName (Maybe (MVar UncheckedImport)),
 (ImportName, Maybe (MVar UncheckedImport)))
-> IO
     (Map ImportName (Maybe (MVar UncheckedImport)),
      (ImportName, Maybe (MVar UncheckedImport)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImportName
-> Maybe (MVar UncheckedImport)
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Map ImportName (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ImportName
include Maybe (MVar UncheckedImport)
prog_mvar Map ImportName (Maybe (MVar UncheckedImport))
state, (ImportName
include, Maybe (MVar UncheckedImport)
prog_mvar))
      where
        include :: ImportName
include = FilePath -> ImportName
mkInitialImport FilePath
fp_name
        (FilePath
fp_name, FilePath
_) = FilePath -> (FilePath, FilePath)
Posix.splitExtension FilePath
fp

asImports :: [LoadedFile (VNameSource, FileModule)] -> Imports
asImports :: [LoadedFile (VNameSource, FileModule)] -> Imports
asImports = (LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule))
-> [LoadedFile (VNameSource, FileModule)] -> Imports
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule)
forall a b. LoadedFile (a, b) -> (FilePath, b)
f
  where
    f :: LoadedFile (a, b) -> (FilePath, b)
f LoadedFile (a, b)
lf = (ImportName -> FilePath
includeToString (LoadedFile (a, b) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile (a, b)
lf), (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> (a, b) -> b
forall a b. (a -> b) -> a -> b
$ LoadedFile (a, b) -> (a, b)
forall fm. LoadedFile fm -> fm
lfMod LoadedFile (a, b)
lf)

typeCheckProg ::
  MonadError CompilerError m =>
  [LoadedFile (VNameSource, FileModule)] ->
  VNameSource ->
  [LoadedFile E.UncheckedProg] ->
  m (E.Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
typeCheckProg :: [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
typeCheckProg [LoadedFile (VNameSource, FileModule)]
orig_imports VNameSource
orig_src =
  ((Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
 -> LoadedFile UncheckedProg
 -> m (Warnings, [LoadedFile (VNameSource, FileModule)],
       VNameSource))
-> (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> LoadedFile UncheckedProg
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
forall (m :: * -> *).
MonadError CompilerError m =>
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> LoadedFile UncheckedProg
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
f (Warnings
forall a. Monoid a => a
mempty, [LoadedFile (VNameSource, FileModule)]
orig_imports, VNameSource
orig_src)
  where
    roots :: [FilePath]
roots = [FilePath
"/prelude/prelude"]

    f :: (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> LoadedFile UncheckedProg
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
f (Warnings
ws, [LoadedFile (VNameSource, FileModule)]
imports, VNameSource
src) (LoadedFile FilePath
path ImportName
import_name UncheckedProg
prog UTCTime
mod_time) = do
      let prog' :: UncheckedProg
prog'
            | FilePath
"/prelude" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ImportName -> FilePath
includeToFilePath ImportName
import_name = UncheckedProg
prog
            | Bool
otherwise = [FilePath] -> UncheckedProg -> UncheckedProg
prependRoots [FilePath]
roots UncheckedProg
prog
      case Imports
-> VNameSource
-> ImportName
-> UncheckedProg
-> (Warnings, Either TypeError (FileModule, VNameSource))
E.checkProg ([LoadedFile (VNameSource, FileModule)] -> Imports
asImports [LoadedFile (VNameSource, FileModule)]
imports) VNameSource
src ImportName
import_name UncheckedProg
prog' of
        (Warnings
prog_ws, Left TypeError
err) -> do
          let ws' :: Warnings
ws' = Warnings
ws Warnings -> Warnings -> Warnings
forall a. Semigroup a => a -> a -> a
<> Warnings
prog_ws
          Doc
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
forall (m :: * -> *) a. MonadError CompilerError m => Doc -> m a
externalError (Doc
 -> m (Warnings, [LoadedFile (VNameSource, FileModule)],
       VNameSource))
-> Doc
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
forall a b. (a -> b) -> a -> b
$
            if Warnings -> Bool
anyWarnings Warnings
ws'
              then Warnings -> Doc
forall a. Pretty a => a -> Doc
ppr Warnings
ws' Doc -> Doc -> Doc
</> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> TypeError -> Doc
forall a. Pretty a => a -> Doc
ppr TypeError
err
              else TypeError -> Doc
forall a. Pretty a => a -> Doc
ppr TypeError
err
        (Warnings
prog_ws, Right (FileModule
m, VNameSource
src')) ->
          (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( Warnings
ws Warnings -> Warnings -> Warnings
forall a. Semigroup a => a -> a -> a
<> Warnings
prog_ws,
              [LoadedFile (VNameSource, FileModule)]
imports [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
forall a. [a] -> [a] -> [a]
++ [FilePath
-> ImportName
-> (VNameSource, FileModule)
-> UTCTime
-> LoadedFile (VNameSource, FileModule)
forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile FilePath
path ImportName
import_name (VNameSource
src, FileModule
m) UTCTime
mod_time],
              VNameSource
src'
            )

setEntryPoints ::
  [E.Name] ->
  [FilePath] ->
  [LoadedFile E.UncheckedProg] ->
  [LoadedFile E.UncheckedProg]
setEntryPoints :: [Name]
-> [FilePath]
-> [LoadedFile UncheckedProg]
-> [LoadedFile UncheckedProg]
setEntryPoints [Name]
extra_eps [FilePath]
fps = (LoadedFile UncheckedProg -> LoadedFile UncheckedProg)
-> [LoadedFile UncheckedProg] -> [LoadedFile UncheckedProg]
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile UncheckedProg -> LoadedFile UncheckedProg
onFile
  where
    fps' :: [FilePath]
fps' = ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
normalise [FilePath]
fps
    onFile :: LoadedFile UncheckedProg -> LoadedFile UncheckedProg
onFile LoadedFile UncheckedProg
lf
      | ImportName -> FilePath
includeToFilePath (LoadedFile UncheckedProg -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile UncheckedProg
lf) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
fps' =
        LoadedFile UncheckedProg
lf {lfMod :: UncheckedProg
lfMod = UncheckedProg
prog {progDecs :: [DecBase NoInfo Name]
E.progDecs = (DecBase NoInfo Name -> DecBase NoInfo Name)
-> [DecBase NoInfo Name] -> [DecBase NoInfo Name]
forall a b. (a -> b) -> [a] -> [b]
map DecBase NoInfo Name -> DecBase NoInfo Name
onDec (UncheckedProg -> [DecBase NoInfo Name]
forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
E.progDecs UncheckedProg
prog)}}
      | Bool
otherwise =
        LoadedFile UncheckedProg
lf
      where
        prog :: UncheckedProg
prog = LoadedFile UncheckedProg -> UncheckedProg
forall fm. LoadedFile fm -> fm
lfMod LoadedFile UncheckedProg
lf

    onDec :: DecBase NoInfo Name -> DecBase NoInfo Name
onDec (E.ValDec ValBindBase NoInfo Name
vb)
      | ValBindBase NoInfo Name -> Name
forall (f :: * -> *) vn. ValBindBase f vn -> vn
E.valBindName ValBindBase NoInfo Name
vb Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
extra_eps =
        ValBindBase NoInfo Name -> DecBase NoInfo Name
forall (f :: * -> *) vn. ValBindBase f vn -> DecBase f vn
E.ValDec ValBindBase NoInfo Name
vb {valBindEntryPoint :: Maybe (NoInfo EntryPoint)
E.valBindEntryPoint = NoInfo EntryPoint -> Maybe (NoInfo EntryPoint)
forall a. a -> Maybe a
Just NoInfo EntryPoint
forall a. NoInfo a
E.NoInfo}
    onDec DecBase NoInfo Name
dec = DecBase NoInfo Name
dec

prependRoots :: [FilePath] -> E.UncheckedProg -> E.UncheckedProg
prependRoots :: [FilePath] -> UncheckedProg -> UncheckedProg
prependRoots [FilePath]
roots (E.Prog Maybe DocComment
doc [DecBase NoInfo Name]
ds) =
  Maybe DocComment -> [DecBase NoInfo Name] -> UncheckedProg
forall (f :: * -> *) vn.
Maybe DocComment -> [DecBase f vn] -> ProgBase f vn
E.Prog Maybe DocComment
doc ([DecBase NoInfo Name] -> UncheckedProg)
-> [DecBase NoInfo Name] -> UncheckedProg
forall a b. (a -> b) -> a -> b
$ (FilePath -> DecBase NoInfo Name)
-> [FilePath] -> [DecBase NoInfo Name]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> DecBase NoInfo Name
forall vn. FilePath -> DecBase NoInfo vn
mkImport [FilePath]
roots [DecBase NoInfo Name]
-> [DecBase NoInfo Name] -> [DecBase NoInfo Name]
forall a. [a] -> [a] -> [a]
++ [DecBase NoInfo Name]
ds
  where
    mkImport :: FilePath -> DecBase NoInfo vn
mkImport FilePath
fp =
      -- We do not use ImportDec here, because we do not want the
      -- type checker to issue a warning about a redundant import.
      DecBase NoInfo vn -> SrcLoc -> DecBase NoInfo vn
forall (f :: * -> *) vn. DecBase f vn -> SrcLoc -> DecBase f vn
E.LocalDec (ModExpBase NoInfo vn -> SrcLoc -> DecBase NoInfo vn
forall (f :: * -> *) vn. ModExpBase f vn -> SrcLoc -> DecBase f vn
E.OpenDec (FilePath -> NoInfo FilePath -> SrcLoc -> ModExpBase NoInfo vn
forall (f :: * -> *) vn.
FilePath -> f FilePath -> SrcLoc -> ModExpBase f vn
E.ModImport FilePath
fp NoInfo FilePath
forall a. NoInfo a
E.NoInfo SrcLoc
forall a. Monoid a => a
mempty) SrcLoc
forall a. Monoid a => a
mempty) SrcLoc
forall a. Monoid a => a
mempty

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

-- | The 'Imports' of a 'LoadedProg', as expected by e.g. type
-- checking functions.
lpImports :: LoadedProg -> Imports
lpImports :: LoadedProg -> Imports
lpImports = (LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule))
-> [LoadedFile (VNameSource, FileModule)] -> Imports
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule)
forall a b. LoadedFile (a, b) -> (FilePath, b)
f ([LoadedFile (VNameSource, FileModule)] -> Imports)
-> (LoadedProg -> [LoadedFile (VNameSource, FileModule)])
-> LoadedProg
-> Imports
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles
  where
    f :: LoadedFile (a, b) -> (FilePath, b)
f LoadedFile (a, b)
lf = (ImportName -> FilePath
includeToString (LoadedFile (a, b) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile (a, b)
lf), (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> (a, b) -> b
forall a b. (a -> b) -> a -> b
$ LoadedFile (a, b) -> (a, b)
forall fm. LoadedFile fm -> fm
lfMod LoadedFile (a, b)
lf)

unchangedImports ::
  MonadIO m =>
  VNameSource ->
  [LoadedFile (VNameSource, FileModule)] ->
  m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports :: VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [] = ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], VNameSource
src)
unchangedImports VNameSource
src (LoadedFile (VNameSource, FileModule)
f : [LoadedFile (VNameSource, FileModule)]
fs)
  | FilePath
"/prelude" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ImportName -> FilePath
includeToFilePath (LoadedFile (VNameSource, FileModule) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile (VNameSource, FileModule)
f) =
    ([LoadedFile (VNameSource, FileModule)]
 -> [LoadedFile (VNameSource, FileModule)])
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (LoadedFile (VNameSource, FileModule)
f LoadedFile (VNameSource, FileModule)
-> [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
forall a. a -> [a] -> [a]
:) (([LoadedFile (VNameSource, FileModule)], VNameSource)
 -> ([LoadedFile (VNameSource, FileModule)], VNameSource))
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [LoadedFile (VNameSource, FileModule)]
fs
  | Bool
otherwise = do
    Bool
changed <-
      Bool
-> (Either FilePath UTCTime -> Bool)
-> Maybe (Either FilePath UTCTime)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((FilePath -> Bool)
-> (UTCTime -> Bool) -> Either FilePath UTCTime -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> FilePath -> Bool
forall a b. a -> b -> a
const Bool
True) (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> LoadedFile (VNameSource, FileModule) -> UTCTime
forall fm. LoadedFile fm -> UTCTime
lfModTime LoadedFile (VNameSource, FileModule)
f))
        (Maybe (Either FilePath UTCTime) -> Bool)
-> m (Maybe (Either FilePath UTCTime)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Either FilePath UTCTime))
-> m (Maybe (Either FilePath UTCTime))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> IO (Maybe (Either FilePath UTCTime))
forall a. IO a -> IO (Maybe (Either FilePath a))
interactWithFileSafely (FilePath -> IO UTCTime
getModificationTime (FilePath -> IO UTCTime) -> FilePath -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ LoadedFile (VNameSource, FileModule) -> FilePath
forall fm. LoadedFile fm -> FilePath
lfPath LoadedFile (VNameSource, FileModule)
f))
    if Bool
changed
      then ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], (VNameSource, FileModule) -> VNameSource
forall a b. (a, b) -> a
fst ((VNameSource, FileModule) -> VNameSource)
-> (VNameSource, FileModule) -> VNameSource
forall a b. (a -> b) -> a -> b
$ LoadedFile (VNameSource, FileModule) -> (VNameSource, FileModule)
forall fm. LoadedFile fm -> fm
lfMod LoadedFile (VNameSource, FileModule)
f)
      else ([LoadedFile (VNameSource, FileModule)]
 -> [LoadedFile (VNameSource, FileModule)])
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (LoadedFile (VNameSource, FileModule)
f LoadedFile (VNameSource, FileModule)
-> [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
forall a. a -> [a] -> [a]
:) (([LoadedFile (VNameSource, FileModule)], VNameSource)
 -> ([LoadedFile (VNameSource, FileModule)], VNameSource))
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [LoadedFile (VNameSource, FileModule)]
fs

-- | A "loaded program" containing no actual files.  Use this as a
-- starting point for 'reloadProg'
noLoadedProg :: LoadedProg
noLoadedProg :: LoadedProg
noLoadedProg =
  LoadedProg :: [FilePath]
-> [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> LoadedProg
LoadedProg
    { lpRoots :: [FilePath]
lpRoots = [],
      lpFiles :: [LoadedFile (VNameSource, FileModule)]
lpFiles = [LoadedFile (VNameSource, FileModule)]
forall a. Monoid a => a
mempty,
      lpNameSource :: VNameSource
lpNameSource = Int -> VNameSource
newNameSource (Int -> VNameSource) -> Int -> VNameSource
forall a b. (a -> b) -> a -> b
$ Int
E.maxIntrinsicTag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    }

-- | Find out how many of the old imports can be used.  Here we are
-- forced to be overly conservative, because our type checker
-- enforces a linear ordering.
usableLoadedProg :: MonadIO m => LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg :: LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg (LoadedProg [FilePath]
roots [LoadedFile (VNameSource, FileModule)]
imports VNameSource
src) [FilePath]
new_roots
  | [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
roots [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
new_roots = do
    ([LoadedFile (VNameSource, FileModule)]
imports', VNameSource
src') <- VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [LoadedFile (VNameSource, FileModule)]
imports
    LoadedProg -> m LoadedProg
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoadedProg -> m LoadedProg) -> LoadedProg -> m LoadedProg
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> LoadedProg
LoadedProg [] [LoadedFile (VNameSource, FileModule)]
imports' VNameSource
src'
  | Bool
otherwise =
    LoadedProg -> m LoadedProg
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoadedProg
noLoadedProg

-- | Extend a loaded program with (possibly new) files.
extendProg ::
  (MonadError CompilerError m, MonadIO m) =>
  LoadedProg ->
  [FilePath] ->
  m (E.Warnings, LoadedProg)
extendProg :: LoadedProg -> [FilePath] -> m (Warnings, LoadedProg)
extendProg LoadedProg
lp [FilePath]
new_roots = do
  [LoadedFile UncheckedProg]
new_imports_untyped <-
    [ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
readUntypedLibraryExceptKnown ((LoadedFile (VNameSource, FileModule) -> ImportName)
-> [LoadedFile (VNameSource, FileModule)] -> [ImportName]
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile (VNameSource, FileModule) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName ([LoadedFile (VNameSource, FileModule)] -> [ImportName])
-> [LoadedFile (VNameSource, FileModule)] -> [ImportName]
forall a b. (a -> b) -> a -> b
$ LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles LoadedProg
lp) [FilePath]
new_roots
  (Warnings
ws, [LoadedFile (VNameSource, FileModule)]
imports, VNameSource
src') <-
    [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
forall (m :: * -> *).
MonadError CompilerError m =>
[LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
typeCheckProg (LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles LoadedProg
lp) (LoadedProg -> VNameSource
lpNameSource LoadedProg
lp) [LoadedFile UncheckedProg]
new_imports_untyped
  (Warnings, LoadedProg) -> m (Warnings, LoadedProg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Warnings
ws, [FilePath]
-> [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> LoadedProg
LoadedProg ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd (LoadedProg -> [FilePath]
lpRoots LoadedProg
lp [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
new_roots)) [LoadedFile (VNameSource, FileModule)]
imports VNameSource
src')

-- | Load some new files, reusing as much of the previously loaded
-- program as possible.  This does not *extend* the currently loaded
-- program the way 'extendProg' does it, so it is always correct (if
-- less efficient) to pass 'noLoadedProg'.
reloadProg ::
  (MonadError CompilerError m, MonadIO m) =>
  LoadedProg ->
  [FilePath] ->
  m (E.Warnings, LoadedProg)
reloadProg :: LoadedProg -> [FilePath] -> m (Warnings, LoadedProg)
reloadProg LoadedProg
lp [FilePath]
new_roots = do
  LoadedProg
lp' <- LoadedProg -> [FilePath] -> m LoadedProg
forall (m :: * -> *).
MonadIO m =>
LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg LoadedProg
lp [FilePath]
new_roots
  LoadedProg -> [FilePath] -> m (Warnings, LoadedProg)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
LoadedProg -> [FilePath] -> m (Warnings, LoadedProg)
extendProg LoadedProg
lp' [FilePath]
new_roots

-- | Read and type-check some Futhark files.
readLibrary ::
  (MonadError CompilerError m, MonadIO m) =>
  -- | 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] ->
  m (E.Warnings, Imports, VNameSource)
readLibrary :: [Name] -> [FilePath] -> m (Warnings, Imports, VNameSource)
readLibrary [Name]
extra_eps [FilePath]
fps =
  ((Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
 -> (Warnings, Imports, VNameSource))
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
-> m (Warnings, Imports, VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> (Warnings, Imports, VNameSource)
forall a c.
(a, [LoadedFile (VNameSource, FileModule)], c) -> (a, Imports, c)
frob
    (m (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
 -> m (Warnings, Imports, VNameSource))
-> ([LoadedFile UncheckedProg]
    -> m (Warnings, [LoadedFile (VNameSource, FileModule)],
          VNameSource))
-> [LoadedFile UncheckedProg]
-> m (Warnings, Imports, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
forall (m :: * -> *).
MonadError CompilerError m =>
[LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
typeCheckProg [LoadedFile (VNameSource, FileModule)]
forall a. Monoid a => a
mempty (LoadedProg -> VNameSource
lpNameSource LoadedProg
noLoadedProg)
    ([LoadedFile UncheckedProg]
 -> m (Warnings, [LoadedFile (VNameSource, FileModule)],
       VNameSource))
-> ([LoadedFile UncheckedProg] -> [LoadedFile UncheckedProg])
-> [LoadedFile UncheckedProg]
-> m (Warnings, [LoadedFile (VNameSource, FileModule)],
      VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name]
-> [FilePath]
-> [LoadedFile UncheckedProg]
-> [LoadedFile UncheckedProg]
setEntryPoints (Name
E.defaultEntryPoint Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
extra_eps) [FilePath]
fps
    ([LoadedFile UncheckedProg] -> m (Warnings, Imports, VNameSource))
-> m [LoadedFile UncheckedProg]
-> m (Warnings, Imports, VNameSource)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
readUntypedLibraryExceptKnown [] [FilePath]
fps
  where
    frob :: (a, [LoadedFile (VNameSource, FileModule)], c) -> (a, Imports, c)
frob (a
x, [LoadedFile (VNameSource, FileModule)]
y, c
z) = (a
x, [LoadedFile (VNameSource, FileModule)] -> Imports
asImports [LoadedFile (VNameSource, FileModule)]
y, c
z)

-- | Read (and parse) all source files (including the builtin prelude)
-- corresponding to a set of root files.
readUntypedLibrary ::
  (MonadIO m, MonadError CompilerError m) =>
  [FilePath] ->
  m [(ImportName, E.UncheckedProg)]
readUntypedLibrary :: [FilePath] -> m [(ImportName, UncheckedProg)]
readUntypedLibrary = ([LoadedFile UncheckedProg] -> [(ImportName, UncheckedProg)])
-> m [LoadedFile UncheckedProg] -> m [(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) (m [LoadedFile UncheckedProg] -> m [(ImportName, UncheckedProg)])
-> ([FilePath] -> m [LoadedFile UncheckedProg])
-> [FilePath]
-> m [(ImportName, UncheckedProg)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> [FilePath] -> m [LoadedFile UncheckedProg]
readUntypedLibraryExceptKnown []
  where
    f :: LoadedFile b -> (ImportName, b)
f LoadedFile b
lf = (LoadedFile b -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile b
lf, LoadedFile b -> b
forall fm. LoadedFile fm -> fm
lfMod LoadedFile b
lf)