{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
-- | Low-level compilation parts.  Look at "Futhark.Compiler" for a
-- more high-level API.
module Futhark.Compiler.Program
       ( readLibraryWithBasis
       , readImports
       , Imports
       , FileModule(..)
       , E.Warnings

       , Basis(..)
       , emptyBasis
       )
where

import Data.Loc
import Control.Exception
import Control.Monad
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Except
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.List (intercalate)
import qualified System.FilePath.Posix as Posix
import System.IO.Error
import qualified Data.Text as T
import qualified Data.Text.IO as T

import Futhark.Error
import Futhark.FreshNames
import Language.Futhark.Parser
import qualified Language.Futhark as E
import qualified Language.Futhark.TypeChecker as E
import Language.Futhark.Semantic
import Language.Futhark.Prelude
import Futhark.Util.Pretty (ppr)

-- | A little monad for reading and type-checking a Futhark program.
type CompilerM m = ReaderT [FilePath] (StateT ReaderState m)

data ReaderState = ReaderState { ReaderState -> Imports
alreadyImported :: Imports
                               , ReaderState -> VNameSource
nameSource :: VNameSource
                               , ReaderState -> Warnings
warnings :: E.Warnings
                               }

-- | Pre-typechecked imports, including a starting point for the name source.
data Basis = Basis { Basis -> Imports
basisImports :: Imports
                   , Basis -> VNameSource
basisNameSource :: VNameSource
                   , Basis -> [String]
basisRoots :: [String]
                     -- ^ Files that should be implicitly opened.
                   }

-- | A basis that contains no imports, and has a properly initialised
-- name source.
emptyBasis :: Basis
emptyBasis :: Basis
emptyBasis = Basis :: Imports -> VNameSource -> [String] -> Basis
Basis { basisImports :: Imports
basisImports = Imports
forall a. Monoid a => a
mempty
                   , basisNameSource :: VNameSource
basisNameSource = VNameSource
src
                   , basisRoots :: [String]
basisRoots = [String]
forall a. Monoid a => a
mempty
                   }
  where src :: VNameSource
src = Int -> VNameSource
newNameSource (Int -> VNameSource) -> Int -> VNameSource
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (VName -> Int) -> [VName] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map VName -> Int
E.baseTag ([VName] -> [Int]) -> [VName] -> [Int]
forall a b. (a -> b) -> a -> b
$ Map VName Intrinsic -> [VName]
forall k a. Map k a -> [k]
M.keys Map VName Intrinsic
E.intrinsics

readImport :: (MonadError CompilerError m, MonadIO m) =>
              [ImportName] -> ImportName -> CompilerM m ()
readImport :: [ImportName] -> ImportName -> CompilerM m ()
readImport [ImportName]
steps ImportName
include
  | ImportName
include ImportName -> [ImportName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImportName]
steps =
      String -> CompilerM m ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> CompilerM m ()) -> String -> CompilerM m ()
forall a b. (a -> b) -> a -> b
$
      String
"Import cycle: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" -> "
      ((ImportName -> String) -> [ImportName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ImportName -> String
includeToString ([ImportName] -> [String]) -> [ImportName] -> [String]
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
includeImportName -> [ImportName] -> [ImportName]
forall a. a -> [a] -> [a]
:[ImportName]
steps)
  | Bool
otherwise = do
      Bool
already_done <- (ReaderState -> Bool)
-> ReaderT [String] (StateT ReaderState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((ReaderState -> Bool)
 -> ReaderT [String] (StateT ReaderState m) Bool)
-> (ReaderState -> Bool)
-> ReaderT [String] (StateT ReaderState m) Bool
forall a b. (a -> b) -> a -> b
$ Maybe FileModule -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FileModule -> Bool)
-> (ReaderState -> Maybe FileModule) -> ReaderState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Imports -> Maybe FileModule
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ImportName -> String
includeToString ImportName
include) (Imports -> Maybe FileModule)
-> (ReaderState -> Imports) -> ReaderState -> Maybe FileModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderState -> Imports
alreadyImported

      Bool -> CompilerM m () -> CompilerM m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
already_done (CompilerM m () -> CompilerM m ())
-> CompilerM m () -> CompilerM m ()
forall a b. (a -> b) -> a -> b
$
        (Text -> String -> CompilerM m ())
-> (Text, String) -> CompilerM m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([ImportName] -> ImportName -> Text -> String -> CompilerM m ()
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> ImportName -> Text -> String -> CompilerM m ()
handleFile [ImportName]
steps ImportName
include) ((Text, String) -> CompilerM m ())
-> ReaderT [String] (StateT ReaderState m) (Text, String)
-> CompilerM m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImportName
-> ReaderT [String] (StateT ReaderState m) (Text, String)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
ImportName -> m (Text, String)
readImportFile ImportName
include

handleFile :: (MonadIO m, MonadError CompilerError m) =>
              [ImportName]
           -> ImportName
           -> T.Text
           -> FilePath
           -> CompilerM m ()
handleFile :: [ImportName] -> ImportName -> Text -> String -> CompilerM m ()
handleFile [ImportName]
steps ImportName
include Text
file_contents String
file_name = do
  UncheckedProg
prog <- case String -> Text -> Either ParseError UncheckedProg
parseFuthark String
file_name Text
file_contents of
    Left ParseError
err -> String -> ReaderT [String] (StateT ReaderState m) UncheckedProg
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> ReaderT [String] (StateT ReaderState m) UncheckedProg)
-> String -> ReaderT [String] (StateT ReaderState m) UncheckedProg
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
    Right UncheckedProg
prog -> UncheckedProg
-> ReaderT [String] (StateT ReaderState m) UncheckedProg
forall (m :: * -> *) a. Monad m => a -> m a
return UncheckedProg
prog

  ((String, SrcLoc) -> CompilerM m ())
-> [(String, SrcLoc)] -> CompilerM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ImportName] -> ImportName -> CompilerM m ()
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[ImportName] -> ImportName -> CompilerM m ()
readImport [ImportName]
steps' (ImportName -> CompilerM m ())
-> ((String, SrcLoc) -> ImportName)
-> (String, SrcLoc)
-> CompilerM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> SrcLoc -> ImportName) -> (String, SrcLoc) -> ImportName
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ImportName -> String -> SrcLoc -> ImportName
mkImportFrom ImportName
include)) ([(String, SrcLoc)] -> CompilerM m ())
-> [(String, SrcLoc)] -> CompilerM m ()
forall a b. (a -> b) -> a -> b
$
    UncheckedProg -> [(String, SrcLoc)]
forall (f :: * -> *) vn. ProgBase f vn -> [(String, SrcLoc)]
E.progImports UncheckedProg
prog

  -- It is important to not read these before the above calls to
  -- readImport.
  Imports
imports <- (ReaderState -> Imports)
-> ReaderT [String] (StateT ReaderState m) Imports
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ReaderState -> Imports
alreadyImported
  VNameSource
src <- (ReaderState -> VNameSource)
-> ReaderT [String] (StateT ReaderState m) VNameSource
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ReaderState -> VNameSource
nameSource
  [String]
roots <- ReaderT [String] (StateT ReaderState m) [String]
forall r (m :: * -> *). MonadReader r m => m r
ask

  case Imports
-> VNameSource
-> ImportName
-> UncheckedProg
-> Either TypeError (FileModule, Warnings, VNameSource)
E.checkProg Imports
imports VNameSource
src ImportName
include (UncheckedProg
 -> Either TypeError (FileModule, Warnings, VNameSource))
-> UncheckedProg
-> Either TypeError (FileModule, Warnings, VNameSource)
forall a b. (a -> b) -> a -> b
$ [String] -> UncheckedProg -> UncheckedProg
prependRoots [String]
roots UncheckedProg
prog of
    Left TypeError
err ->
      Doc -> CompilerM m ()
forall (m :: * -> *) a. MonadError CompilerError m => Doc -> m a
externalError (Doc -> CompilerM m ()) -> Doc -> CompilerM m ()
forall a b. (a -> b) -> a -> b
$ TypeError -> Doc
forall a. Pretty a => a -> Doc
ppr TypeError
err
    Right (FileModule
m, Warnings
ws, VNameSource
src') ->
      (ReaderState -> ReaderState) -> CompilerM m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState) -> CompilerM m ())
-> (ReaderState -> ReaderState) -> CompilerM m ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
s ->
        ReaderState
s { alreadyImported :: Imports
alreadyImported = (ImportName -> String
includeToString ImportName
include,FileModule
m) (String, FileModule) -> Imports -> Imports
forall a. a -> [a] -> [a]
: Imports
imports
          , nameSource :: VNameSource
nameSource      = VNameSource
src'
          , warnings :: Warnings
warnings        = ReaderState -> Warnings
warnings ReaderState
s Warnings -> Warnings -> Warnings
forall a. Semigroup a => a -> a -> a
<> Warnings
ws
          }
  where steps' :: [ImportName]
steps' = ImportName
includeImportName -> [ImportName] -> [ImportName]
forall a. a -> [a] -> [a]
:[ImportName]
steps

readFileSafely :: String -> IO (Maybe (Either String (String, T.Text)))
readFileSafely :: String -> IO (Maybe (Either String (String, Text)))
readFileSafely String
filepath =
  (Either String (String, Text)
-> Maybe (Either String (String, Text))
forall a. a -> Maybe a
Just (Either String (String, Text)
 -> Maybe (Either String (String, Text)))
-> (Text -> Either String (String, Text))
-> Text
-> Maybe (Either String (String, Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Text) -> Either String (String, Text)
forall a b. b -> Either a b
Right ((String, Text) -> Either String (String, Text))
-> (Text -> (String, Text)) -> Text -> Either String (String, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
filepath,) (Text -> Maybe (Either String (String, Text)))
-> IO Text -> IO (Maybe (Either String (String, Text)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
filepath) IO (Maybe (Either String (String, Text)))
-> (IOError -> IO (Maybe (Either String (String, Text))))
-> IO (Maybe (Either String (String, Text)))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO (Maybe (Either String (String, Text)))
forall (m :: * -> *) b.
Monad m =>
IOError -> m (Maybe (Either String b))
couldNotRead
  where couldNotRead :: IOError -> m (Maybe (Either String b))
couldNotRead IOError
e
          | IOError -> Bool
isDoesNotExistError IOError
e =
              Maybe (Either String b) -> m (Maybe (Either String b))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either String b)
forall a. Maybe a
Nothing
          | Bool
otherwise             =
              Maybe (Either String b) -> m (Maybe (Either String b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either String b) -> m (Maybe (Either String b)))
-> Maybe (Either String b) -> m (Maybe (Either String b))
forall a b. (a -> b) -> a -> b
$ Either String b -> Maybe (Either String b)
forall a. a -> Maybe a
Just (Either String b -> Maybe (Either String b))
-> Either String b -> Maybe (Either String b)
forall a b. (a -> b) -> a -> b
$ String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ IOError -> String
forall a. Show a => a -> String
show IOError
e

readImportFile :: (MonadError CompilerError m, MonadIO m) =>
                  ImportName -> m (T.Text, FilePath)
readImportFile :: ImportName -> m (Text, String)
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.
  Maybe (Either String (String, Text))
r <- IO (Maybe (Either String (String, Text)))
-> m (Maybe (Either String (String, Text)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either String (String, Text)))
 -> m (Maybe (Either String (String, Text))))
-> IO (Maybe (Either String (String, Text)))
-> m (Maybe (Either String (String, Text)))
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe (Either String (String, Text)))
readFileSafely (String -> IO (Maybe (Either String (String, Text))))
-> String -> IO (Maybe (Either String (String, Text)))
forall a b. (a -> b) -> a -> b
$ ImportName -> String
includeToFilePath ImportName
include
  case (Maybe (Either String (String, Text))
r, String -> [(String, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
prelude_str [(String, Text)]
prelude) of
    (Just (Right (String
filepath,Text
s)), Maybe Text
_) -> (Text, String) -> m (Text, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, String
filepath)
    (Just (Left String
e), Maybe Text
_)  -> String -> m (Text, String)
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS String
e
    (Maybe (Either String (String, Text))
Nothing, Just Text
t)   -> (Text, String) -> m (Text, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t, String
prelude_str)
    (Maybe (Either String (String, Text))
Nothing, Maybe Text
Nothing)  -> String -> m (Text, String)
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS String
not_found
   where prelude_str :: String
prelude_str = String
"/" String -> String -> String
Posix.</> ImportName -> String
includeToString ImportName
include String -> String -> String
Posix.<.> String
"fut"

         not_found :: String
not_found =
           String
"Error at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
forall a. Located a => a -> String
E.locStr (ImportName -> SrcLoc
forall a. Located a => a -> SrcLoc
srclocOf ImportName
include) String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
": could not find import '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ImportName -> String
includeToString ImportName
include String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'."

-- | Read Futhark files from some basis, and printing log messages if
-- the first parameter is True.
readLibraryWithBasis :: (MonadError CompilerError m, MonadIO m) =>
                        Basis -> [FilePath]
                     -> m (E.Warnings,
                           Imports,
                           VNameSource)
readLibraryWithBasis :: Basis -> [String] -> m (Warnings, Imports, VNameSource)
readLibraryWithBasis Basis
builtin [String]
fps = do
  (Warnings
_, Imports
imps, VNameSource
src) <- Basis -> CompilerM m () -> m (Warnings, Imports, VNameSource)
forall (m :: * -> *) a.
Monad m =>
Basis -> CompilerM m a -> m (Warnings, Imports, VNameSource)
runCompilerM Basis
builtin (CompilerM m () -> m (Warnings, Imports, VNameSource))
-> CompilerM m () -> m (Warnings, Imports, VNameSource)
forall a b. (a -> b) -> a -> b
$
    [ImportName] -> ImportName -> CompilerM m ()
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[ImportName] -> ImportName -> CompilerM m ()
readImport [] (ImportName -> CompilerM m ()) -> ImportName -> CompilerM m ()
forall a b. (a -> b) -> a -> b
$ String -> ImportName
mkInitialImport String
"/prelude/prelude"
  let basis :: Basis
basis = Imports -> VNameSource -> [String] -> Basis
Basis Imports
imps VNameSource
src [String
"/prelude/prelude"]
  Basis -> [String] -> m (Warnings, Imports, VNameSource)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
Basis -> [String] -> m (Warnings, Imports, VNameSource)
readLibrary' Basis
basis [String]
fps

-- | Read and type-check a Futhark library (multiple files, relative
-- to the same search path), including all imports.
readLibrary' :: (MonadError CompilerError m, MonadIO m) =>
                Basis -> [FilePath]
             -> m (E.Warnings,
                   Imports,
                   VNameSource)
readLibrary' :: Basis -> [String] -> m (Warnings, Imports, VNameSource)
readLibrary' Basis
basis [String]
fps = Basis -> CompilerM m [()] -> m (Warnings, Imports, VNameSource)
forall (m :: * -> *) a.
Monad m =>
Basis -> CompilerM m a -> m (Warnings, Imports, VNameSource)
runCompilerM Basis
basis (CompilerM m [()] -> m (Warnings, Imports, VNameSource))
-> CompilerM m [()] -> m (Warnings, Imports, VNameSource)
forall a b. (a -> b) -> a -> b
$ (String -> ReaderT [String] (StateT ReaderState m) ())
-> [String] -> CompilerM m [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> ReaderT [String] (StateT ReaderState m) ()
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
String -> ReaderT [String] (StateT ReaderState m) ()
onFile [String]
fps
  where onFile :: String -> ReaderT [String] (StateT ReaderState m) ()
onFile String
fp =  do
          Maybe (Either String (String, Text))
r <- IO (Maybe (Either String (String, Text)))
-> ReaderT
     [String]
     (StateT ReaderState m)
     (Maybe (Either String (String, Text)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either String (String, Text)))
 -> ReaderT
      [String]
      (StateT ReaderState m)
      (Maybe (Either String (String, Text))))
-> IO (Maybe (Either String (String, Text)))
-> ReaderT
     [String]
     (StateT ReaderState m)
     (Maybe (Either String (String, Text)))
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe (Either String (String, Text)))
readFileSafely String
fp
          case Maybe (Either String (String, Text))
r of
            Just (Right (String
_, Text
fs)) ->
              [ImportName]
-> ImportName
-> Text
-> String
-> ReaderT [String] (StateT ReaderState m) ()
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> ImportName -> Text -> String -> CompilerM m ()
handleFile [] (String -> ImportName
mkInitialImport String
fp_name) Text
fs String
fp
            Just (Left String
e) -> String -> ReaderT [String] (StateT ReaderState m) ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS String
e
            Maybe (Either String (String, Text))
Nothing -> String -> ReaderT [String] (StateT ReaderState m) ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> ReaderT [String] (StateT ReaderState m) ())
-> String -> ReaderT [String] (StateT ReaderState m) ()
forall a b. (a -> b) -> a -> b
$ String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": file not found."
            where (String
fp_name, String
_) = String -> (String, String)
Posix.splitExtension String
fp

-- | Read and type-check Futhark imports (no @.fut@ extension; may
-- refer to baked-in prelude).  This is an exotic operation that
-- probably only makes sense in an interactive environment.
readImports :: (MonadError CompilerError m, MonadIO m) =>
               Basis -> [ImportName]
            -> m (E.Warnings,
                  Imports,
                  VNameSource)
readImports :: Basis -> [ImportName] -> m (Warnings, Imports, VNameSource)
readImports Basis
basis [ImportName]
imps =
  Basis -> CompilerM m [()] -> m (Warnings, Imports, VNameSource)
forall (m :: * -> *) a.
Monad m =>
Basis -> CompilerM m a -> m (Warnings, Imports, VNameSource)
runCompilerM Basis
basis (CompilerM m [()] -> m (Warnings, Imports, VNameSource))
-> CompilerM m [()] -> m (Warnings, Imports, VNameSource)
forall a b. (a -> b) -> a -> b
$ (ImportName -> ReaderT [String] (StateT ReaderState m) ())
-> [ImportName] -> CompilerM m [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([ImportName]
-> ImportName -> ReaderT [String] (StateT ReaderState m) ()
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[ImportName] -> ImportName -> CompilerM m ()
readImport []) [ImportName]
imps

runCompilerM :: Monad m =>
                Basis -> CompilerM m a
             -> m (E.Warnings, [(String, FileModule)], VNameSource)
runCompilerM :: Basis -> CompilerM m a -> m (Warnings, Imports, VNameSource)
runCompilerM (Basis Imports
imports VNameSource
src [String]
roots) CompilerM m a
m = do
  let s :: ReaderState
s = Imports -> VNameSource -> Warnings -> ReaderState
ReaderState (Imports -> Imports
forall a. [a] -> [a]
reverse Imports
imports) VNameSource
src Warnings
forall a. Monoid a => a
mempty
  ReaderState
s' <- StateT ReaderState m a -> ReaderState -> m ReaderState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (CompilerM m a -> [String] -> StateT ReaderState m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompilerM m a
m [String]
roots) ReaderState
s
  (Warnings, Imports, VNameSource)
-> m (Warnings, Imports, VNameSource)
forall (m :: * -> *) a. Monad m => a -> m a
return (ReaderState -> Warnings
warnings ReaderState
s',
          Imports -> Imports
forall a. [a] -> [a]
reverse (Imports -> Imports) -> Imports -> Imports
forall a b. (a -> b) -> a -> b
$ ReaderState -> Imports
alreadyImported ReaderState
s',
          ReaderState -> VNameSource
nameSource ReaderState
s')

prependRoots :: [FilePath] -> E.UncheckedProg -> E.UncheckedProg
prependRoots :: [String] -> UncheckedProg -> UncheckedProg
prependRoots [String]
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
$ (String -> DecBase NoInfo Name)
-> [String] -> [DecBase NoInfo Name]
forall a b. (a -> b) -> [a] -> [b]
map String -> DecBase NoInfo Name
forall vn. String -> DecBase NoInfo vn
mkImport [String]
roots [DecBase NoInfo Name]
-> [DecBase NoInfo Name] -> [DecBase NoInfo Name]
forall a. [a] -> [a] -> [a]
++ [DecBase NoInfo Name]
ds
  where mkImport :: String -> DecBase NoInfo vn
mkImport String
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 (String -> NoInfo String -> SrcLoc -> ModExpBase NoInfo vn
forall (f :: * -> *) vn.
String -> f String -> SrcLoc -> ModExpBase f vn
E.ModImport String
fp NoInfo String
forall a. NoInfo a
E.NoInfo SrcLoc
forall a. IsLocation a => a
noLoc) SrcLoc
forall a. IsLocation a => a
noLoc) SrcLoc
forall a. IsLocation a => a
noLoc