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

-- | Low-level compilation parts.  Look at "Futhark.Compiler" for a
-- more high-level API.
module Futhark.Compiler.Program
  ( readLibrary,
    readUntypedLibrary,
    readImports,
    Imports,
    FileModule (..),
    E.Warnings,
    Basis (..),
    emptyBasis,
  )
where

import Control.Monad
import Control.Monad.Except
import Control.Monad.State
import Data.List (intercalate, isPrefixOf)
import Data.Maybe
import qualified Data.Text as T
import Futhark.Error
import Futhark.FreshNames
import Futhark.Util (readFileSafely)
import Futhark.Util.Pretty (line, ppr, (</>))
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 qualified System.FilePath.Posix as Posix

newtype ReaderState = ReaderState
  {ReaderState -> [(ImportName, UncheckedProg)]
alreadyRead :: [(ImportName, E.UncheckedProg)]}

-- | A little monad for parsing a Futhark program.
type ReaderM m = StateT ReaderState m

runReaderM ::
  (MonadError CompilerError m) =>
  ReaderM m a ->
  m [(ImportName, E.UncheckedProg)]
runReaderM :: forall (m :: * -> *) a.
MonadError CompilerError m =>
ReaderM m a -> m [(ImportName, UncheckedProg)]
runReaderM ReaderM m a
m = [(ImportName, UncheckedProg)] -> [(ImportName, UncheckedProg)]
forall a. [a] -> [a]
reverse ([(ImportName, UncheckedProg)] -> [(ImportName, UncheckedProg)])
-> (ReaderState -> [(ImportName, UncheckedProg)])
-> ReaderState
-> [(ImportName, UncheckedProg)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderState -> [(ImportName, UncheckedProg)]
alreadyRead (ReaderState -> [(ImportName, UncheckedProg)])
-> m ReaderState -> m [(ImportName, UncheckedProg)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderM m a -> ReaderState -> m ReaderState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ReaderM m a
m ([(ImportName, UncheckedProg)] -> ReaderState
ReaderState [(ImportName, UncheckedProg)]
forall a. Monoid a => a
mempty)

readImportFile ::
  (MonadError CompilerError m, MonadIO m) =>
  ImportName ->
  ReaderM m (T.Text, FilePath)
readImportFile :: forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
ImportName -> ReaderM 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.
  let filepath :: String
filepath = ImportName -> String
includeToFilePath ImportName
include
  Maybe (Either String Text)
r <- IO (Maybe (Either String Text))
-> StateT ReaderState m (Maybe (Either String Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either String Text))
 -> StateT ReaderState m (Maybe (Either String Text)))
-> IO (Maybe (Either String Text))
-> StateT ReaderState m (Maybe (Either String Text))
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe (Either String Text))
readFileSafely String
filepath
  case (Maybe (Either 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 Text
s), Maybe Text
_) -> (Text, String) -> ReaderM m (Text, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, String
filepath)
    (Just (Left String
e), Maybe Text
_) -> String -> ReaderM m (Text, String)
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS String
e
    (Maybe (Either String Text)
Nothing, Just Text
t) -> (Text, String) -> ReaderM m (Text, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t, String
prelude_str)
    (Maybe (Either String Text)
Nothing, Maybe Text
Nothing) -> String -> ReaderM 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
E.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
"'."

readImport ::
  (MonadError CompilerError m, MonadIO m) =>
  [ImportName] ->
  ImportName ->
  ReaderM m ()
readImport :: forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[ImportName] -> ImportName -> ReaderM 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 -> StateT ReaderState m ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> StateT ReaderState m ())
-> String -> StateT ReaderState 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
include ImportName -> [ImportName] -> [ImportName]
forall a. a -> [a] -> [a]
: [ImportName]
steps)
  | Bool
otherwise = do
    Bool
already_done <- (ReaderState -> Bool) -> StateT ReaderState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((ReaderState -> Bool) -> StateT ReaderState m Bool)
-> (ReaderState -> Bool) -> StateT ReaderState m Bool
forall a b. (a -> b) -> a -> b
$ Maybe UncheckedProg -> Bool
forall a. Maybe a -> Bool
isJust (Maybe UncheckedProg -> Bool)
-> (ReaderState -> Maybe UncheckedProg) -> ReaderState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportName -> [(ImportName, UncheckedProg)] -> Maybe UncheckedProg
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ImportName
include ([(ImportName, UncheckedProg)] -> Maybe UncheckedProg)
-> (ReaderState -> [(ImportName, UncheckedProg)])
-> ReaderState
-> Maybe UncheckedProg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderState -> [(ImportName, UncheckedProg)]
alreadyRead

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

handleFile ::
  (MonadIO m, MonadError CompilerError m) =>
  [ImportName] ->
  ImportName ->
  T.Text ->
  FilePath ->
  ReaderM m ()
handleFile :: forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> ImportName -> Text -> String -> ReaderM m ()
handleFile [ImportName]
steps ImportName
import_name 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 -> StateT ReaderState m UncheckedProg
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> StateT ReaderState m UncheckedProg)
-> 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 -> StateT ReaderState m UncheckedProg
forall (m :: * -> *) a. Monad m => a -> m a
return UncheckedProg
prog

  let steps' :: [ImportName]
steps' = ImportName
import_name ImportName -> [ImportName] -> [ImportName]
forall a. a -> [a] -> [a]
: [ImportName]
steps
  ((String, SrcLoc) -> ReaderM m ())
-> [(String, SrcLoc)] -> ReaderM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ImportName] -> ImportName -> ReaderM m ()
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[ImportName] -> ImportName -> ReaderM m ()
readImport [ImportName]
steps' (ImportName -> ReaderM m ())
-> ((String, SrcLoc) -> ImportName)
-> (String, SrcLoc)
-> ReaderM 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
import_name)) ([(String, SrcLoc)] -> ReaderM m ())
-> [(String, SrcLoc)] -> ReaderM m ()
forall a b. (a -> b) -> a -> b
$
    UncheckedProg -> [(String, SrcLoc)]
forall (f :: * -> *) vn. ProgBase f vn -> [(String, SrcLoc)]
E.progImports UncheckedProg
prog

  (ReaderState -> ReaderState) -> ReaderM m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState) -> ReaderM m ())
-> (ReaderState -> ReaderState) -> ReaderM m ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
s ->
    ReaderState
s {alreadyRead :: [(ImportName, UncheckedProg)]
alreadyRead = (ImportName
import_name, UncheckedProg
prog) (ImportName, UncheckedProg)
-> [(ImportName, UncheckedProg)] -> [(ImportName, UncheckedProg)]
forall a. a -> [a] -> [a]
: ReaderState -> [(ImportName, UncheckedProg)]
alreadyRead ReaderState
s}

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

-- | 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
E.maxIntrinsicTag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

typeCheckProgram ::
  MonadError CompilerError m =>
  Basis ->
  [(ImportName, E.UncheckedProg)] ->
  m (E.Warnings, Imports, VNameSource)
typeCheckProgram :: forall (m :: * -> *).
MonadError CompilerError m =>
Basis
-> [(ImportName, UncheckedProg)]
-> m (Warnings, Imports, VNameSource)
typeCheckProgram Basis
basis =
  ((Warnings, Imports, VNameSource)
 -> (ImportName, UncheckedProg)
 -> m (Warnings, Imports, VNameSource))
-> (Warnings, Imports, VNameSource)
-> [(ImportName, UncheckedProg)]
-> m (Warnings, Imports, VNameSource)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Warnings, Imports, VNameSource)
-> (ImportName, UncheckedProg)
-> m (Warnings, Imports, VNameSource)
forall {m :: * -> *}.
MonadError CompilerError m =>
(Warnings, Imports, VNameSource)
-> (ImportName, UncheckedProg)
-> m (Warnings, Imports, VNameSource)
f (Warnings
forall a. Monoid a => a
mempty, Basis -> Imports
basisImports Basis
basis, Basis -> VNameSource
basisNameSource Basis
basis)
  where
    roots :: [String]
roots = [String
"/prelude/prelude"]

    f :: (Warnings, Imports, VNameSource)
-> (ImportName, UncheckedProg)
-> m (Warnings, Imports, VNameSource)
f (Warnings
ws, Imports
imports, VNameSource
src) (ImportName
import_name, UncheckedProg
prog) = do
      let prog' :: UncheckedProg
prog'
            | String
"/prelude" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ImportName -> String
includeToFilePath ImportName
import_name = UncheckedProg
prog
            | Bool
otherwise = [String] -> UncheckedProg -> UncheckedProg
prependRoots [String]
roots UncheckedProg
prog
      case Imports
-> VNameSource
-> ImportName
-> UncheckedProg
-> (Warnings, Either TypeError (FileModule, VNameSource))
E.checkProg Imports
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, Imports, VNameSource)
forall (m :: * -> *) a. MonadError CompilerError m => Doc -> m a
externalError (Doc -> m (Warnings, Imports, VNameSource))
-> Doc -> m (Warnings, Imports, 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, Imports, VNameSource)
-> m (Warnings, Imports, 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,
              Imports
imports Imports -> Imports -> Imports
forall a. [a] -> [a] -> [a]
++ [(ImportName -> String
includeToString ImportName
import_name, FileModule
m)],
              VNameSource
src'
            )

setEntryPoints ::
  [E.Name] ->
  [FilePath] ->
  [(ImportName, E.UncheckedProg)] ->
  [(ImportName, E.UncheckedProg)]
setEntryPoints :: [Name]
-> [String]
-> [(ImportName, UncheckedProg)]
-> [(ImportName, UncheckedProg)]
setEntryPoints [Name]
extra_eps [String]
fps = ((ImportName, UncheckedProg) -> (ImportName, UncheckedProg))
-> [(ImportName, UncheckedProg)] -> [(ImportName, UncheckedProg)]
forall a b. (a -> b) -> [a] -> [b]
map (ImportName, UncheckedProg) -> (ImportName, UncheckedProg)
onProg
  where
    onProg :: (ImportName, UncheckedProg) -> (ImportName, UncheckedProg)
onProg (ImportName
name, UncheckedProg
prog)
      | ImportName -> String
includeToFilePath ImportName
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
fps =
        (ImportName
name, 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 =
        (ImportName
name, UncheckedProg
prog)

    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

-- | 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 :: forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[String] -> m [(ImportName, UncheckedProg)]
readUntypedLibrary [String]
fps = ReaderM m () -> m [(ImportName, UncheckedProg)]
forall (m :: * -> *) a.
MonadError CompilerError m =>
ReaderM m a -> m [(ImportName, UncheckedProg)]
runReaderM (ReaderM m () -> m [(ImportName, UncheckedProg)])
-> ReaderM m () -> m [(ImportName, UncheckedProg)]
forall a b. (a -> b) -> a -> b
$ do
  [ImportName] -> ImportName -> ReaderM m ()
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[ImportName] -> ImportName -> ReaderM m ()
readImport [] (String -> ImportName
mkInitialImport String
"/prelude/prelude")
  (String -> ReaderM m ()) -> [String] -> ReaderM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> ReaderM m ()
forall {m :: * -> *}.
(MonadIO m, MonadError CompilerError m) =>
String -> StateT ReaderState m ()
onFile [String]
fps
  where
    onFile :: String -> StateT ReaderState m ()
onFile String
fp = do
      Maybe (Either String Text)
r <- IO (Maybe (Either String Text))
-> StateT ReaderState m (Maybe (Either String Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either String Text))
 -> StateT ReaderState m (Maybe (Either String Text)))
-> IO (Maybe (Either String Text))
-> StateT ReaderState m (Maybe (Either String Text))
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe (Either String Text))
readFileSafely String
fp
      case Maybe (Either String Text)
r of
        Just (Right Text
fs) ->
          [ImportName]
-> ImportName -> Text -> String -> StateT ReaderState m ()
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> ImportName -> Text -> String -> ReaderM m ()
handleFile [] (String -> ImportName
mkInitialImport String
fp_name) Text
fs String
fp
        Just (Left String
e) -> String -> StateT ReaderState m ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS String
e
        Maybe (Either String Text)
Nothing -> String -> StateT ReaderState m ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> StateT ReaderState m ())
-> 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 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 :: forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[Name] -> [String] -> m (Warnings, Imports, VNameSource)
readLibrary [Name]
extra_eps [String]
fps =
  Basis
-> [(ImportName, UncheckedProg)]
-> m (Warnings, Imports, VNameSource)
forall (m :: * -> *).
MonadError CompilerError m =>
Basis
-> [(ImportName, UncheckedProg)]
-> m (Warnings, Imports, VNameSource)
typeCheckProgram Basis
emptyBasis ([(ImportName, UncheckedProg)]
 -> m (Warnings, Imports, VNameSource))
-> ([(ImportName, UncheckedProg)] -> [(ImportName, UncheckedProg)])
-> [(ImportName, UncheckedProg)]
-> m (Warnings, Imports, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name]
-> [String]
-> [(ImportName, UncheckedProg)]
-> [(ImportName, UncheckedProg)]
setEntryPoints [Name]
extra_eps [String]
fps
    ([(ImportName, UncheckedProg)]
 -> m (Warnings, Imports, VNameSource))
-> m [(ImportName, UncheckedProg)]
-> m (Warnings, Imports, VNameSource)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [String] -> m [(ImportName, UncheckedProg)]
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[String] -> m [(ImportName, UncheckedProg)]
readUntypedLibrary [String]
fps

-- | 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 :: forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
Basis -> [ImportName] -> m (Warnings, Imports, VNameSource)
readImports Basis
basis [ImportName]
imps = do
  [(ImportName, UncheckedProg)]
files <- ReaderM m [()] -> m [(ImportName, UncheckedProg)]
forall (m :: * -> *) a.
MonadError CompilerError m =>
ReaderM m a -> m [(ImportName, UncheckedProg)]
runReaderM (ReaderM m [()] -> m [(ImportName, UncheckedProg)])
-> ReaderM m [()] -> m [(ImportName, UncheckedProg)]
forall a b. (a -> b) -> a -> b
$ (ImportName -> StateT ReaderState m ())
-> [ImportName] -> ReaderM m [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([ImportName] -> ImportName -> StateT ReaderState m ()
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[ImportName] -> ImportName -> ReaderM m ()
readImport []) [ImportName]
imps
  Basis
-> [(ImportName, UncheckedProg)]
-> m (Warnings, Imports, VNameSource)
forall (m :: * -> *).
MonadError CompilerError m =>
Basis
-> [(ImportName, UncheckedProg)]
-> m (Warnings, Imports, VNameSource)
typeCheckProgram Basis
basis [(ImportName, UncheckedProg)]
files

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. Monoid a => a
mempty) SrcLoc
forall a. Monoid a => a
mempty) SrcLoc
forall a. Monoid a => a
mempty