{-# 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 System.FilePath (normalise)
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 :: 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 :: ImportName -> ReaderM m (Text, FilePath)
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)
r <- IO (Maybe (Either FilePath Text))
-> StateT ReaderState m (Maybe (Either FilePath Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either FilePath Text))
 -> StateT ReaderState m (Maybe (Either FilePath Text)))
-> IO (Maybe (Either FilePath Text))
-> StateT ReaderState m (Maybe (Either FilePath Text))
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe (Either FilePath Text))
readFileSafely FilePath
filepath
  case (Maybe (Either FilePath Text)
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), Maybe Text
_) -> (Text, FilePath) -> ReaderM m (Text, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
s, FilePath
filepath)
    (Just (Left FilePath
e), Maybe Text
_) -> FilePath -> ReaderM m (Text, FilePath)
forall (m :: * -> *) a.
MonadError CompilerError m =>
FilePath -> m a
externalErrorS FilePath
e
    (Maybe (Either FilePath Text)
Nothing, Just Text
t) -> (Text, FilePath) -> ReaderM m (Text, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t, FilePath
prelude_str)
    (Maybe (Either FilePath Text)
Nothing, Maybe Text
Nothing) -> FilePath -> ReaderM m (Text, FilePath)
forall (m :: * -> *) a.
MonadError CompilerError m =>
FilePath -> m a
externalErrorS FilePath
not_found
  where
    prelude_str :: FilePath
prelude_str = FilePath
"/" FilePath -> FilePath -> FilePath
Posix.</> ImportName -> FilePath
includeToString ImportName
include FilePath -> FilePath -> FilePath
Posix.<.> FilePath
"fut"

    not_found :: FilePath
not_found =
      FilePath
"Error at " FilePath -> FilePath -> FilePath
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 -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": could not find import '"
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ImportName -> FilePath
includeToString ImportName
include
        FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'."

readImport ::
  (MonadError CompilerError m, MonadIO m) =>
  [ImportName] ->
  ImportName ->
  ReaderM m ()
readImport :: [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 =
    FilePath -> ReaderM m ()
forall (m :: * -> *) a.
MonadError CompilerError m =>
FilePath -> m a
externalErrorS (FilePath -> ReaderM m ()) -> FilePath -> ReaderM m ()
forall a b. (a -> b) -> a -> b
$
      FilePath
"Import cycle: "
        FilePath -> FilePath -> FilePath
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
    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 -> ReaderM m () -> ReaderM m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
already_done (ReaderM m () -> ReaderM m ()) -> ReaderM m () -> ReaderM m ()
forall a b. (a -> b) -> a -> b
$
      (Text -> FilePath -> ReaderM m ())
-> (Text, FilePath) -> ReaderM m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([ImportName] -> ImportName -> Text -> FilePath -> ReaderM m ()
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> ImportName -> Text -> FilePath -> ReaderM m ()
handleFile [ImportName]
steps ImportName
include) ((Text, FilePath) -> ReaderM m ())
-> StateT ReaderState m (Text, FilePath) -> ReaderM m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImportName -> StateT ReaderState m (Text, FilePath)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
ImportName -> ReaderM m (Text, FilePath)
readImportFile ImportName
include

handleFile ::
  (MonadIO m, MonadError CompilerError m) =>
  [ImportName] ->
  ImportName ->
  T.Text ->
  FilePath ->
  ReaderM m ()
handleFile :: [ImportName] -> ImportName -> Text -> FilePath -> ReaderM m ()
handleFile [ImportName]
steps ImportName
import_name Text
file_contents FilePath
file_name = do
  UncheckedProg
prog <- case FilePath -> Text -> Either ParseError UncheckedProg
parseFuthark FilePath
file_name Text
file_contents of
    Left ParseError
err -> FilePath -> StateT ReaderState m UncheckedProg
forall (m :: * -> *) a.
MonadError CompilerError m =>
FilePath -> m a
externalErrorS (FilePath -> StateT ReaderState m UncheckedProg)
-> FilePath -> StateT ReaderState m UncheckedProg
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
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
  ((FilePath, SrcLoc) -> ReaderM m ())
-> [(FilePath, 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 ())
-> ((FilePath, SrcLoc) -> ImportName)
-> (FilePath, SrcLoc)
-> ReaderM m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)] -> ReaderM m ())
-> [(FilePath, SrcLoc)] -> ReaderM m ()
forall a b. (a -> b) -> a -> b
$
    UncheckedProg -> [(FilePath, SrcLoc)]
forall (f :: * -> *) vn. ProgBase f vn -> [(FilePath, 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 -> [FilePath]
basisRoots :: [String]
  }

-- | A basis that contains no imports, and has a properly initialised
-- name source.
emptyBasis :: Basis
emptyBasis :: Basis
emptyBasis =
  Basis :: Imports -> VNameSource -> [FilePath] -> Basis
Basis
    { basisImports :: Imports
basisImports = Imports
forall a. Monoid a => a
mempty,
      basisNameSource :: VNameSource
basisNameSource = VNameSource
src,
      basisRoots :: [FilePath]
basisRoots = [FilePath]
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 :: 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 :: [FilePath]
roots = [FilePath
"/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'
            | 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 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 -> FilePath
includeToString ImportName
import_name, FileModule
m)],
              VNameSource
src'
            )

setEntryPoints ::
  [E.Name] ->
  [FilePath] ->
  [(ImportName, E.UncheckedProg)] ->
  [(ImportName, E.UncheckedProg)]
setEntryPoints :: [Name]
-> [FilePath]
-> [(ImportName, UncheckedProg)]
-> [(ImportName, UncheckedProg)]
setEntryPoints [Name]
extra_eps [FilePath]
fps = ((ImportName, UncheckedProg) -> (ImportName, UncheckedProg))
-> [(ImportName, UncheckedProg)] -> [(ImportName, UncheckedProg)]
forall a b. (a -> b) -> [a] -> [b]
map (ImportName, UncheckedProg) -> (ImportName, UncheckedProg)
onProg
  where
    fps' :: [FilePath]
fps' = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
normalise [FilePath]
fps
    onProg :: (ImportName, UncheckedProg) -> (ImportName, UncheckedProg)
onProg (ImportName
name, UncheckedProg
prog)
      | ImportName -> FilePath
includeToFilePath ImportName
name FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
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 :: [FilePath] -> m [(ImportName, UncheckedProg)]
readUntypedLibrary [FilePath]
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 [] (FilePath -> ImportName
mkInitialImport FilePath
"/prelude/prelude")
  (FilePath -> ReaderM m ()) -> [FilePath] -> ReaderM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> ReaderM m ()
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
FilePath -> StateT ReaderState m ()
onFile [FilePath]
fps
  where
    onFile :: FilePath -> StateT ReaderState m ()
onFile FilePath
fp = do
      Maybe (Either FilePath Text)
r <- IO (Maybe (Either FilePath Text))
-> StateT ReaderState m (Maybe (Either FilePath Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either FilePath Text))
 -> StateT ReaderState m (Maybe (Either FilePath Text)))
-> IO (Maybe (Either FilePath Text))
-> StateT ReaderState m (Maybe (Either FilePath Text))
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe (Either FilePath Text))
readFileSafely FilePath
fp
      case Maybe (Either FilePath Text)
r of
        Just (Right Text
fs) ->
          [ImportName]
-> ImportName -> Text -> FilePath -> StateT ReaderState m ()
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[ImportName] -> ImportName -> Text -> FilePath -> ReaderM m ()
handleFile [] (FilePath -> ImportName
mkInitialImport FilePath
fp_name) Text
fs FilePath
fp
        Just (Left FilePath
e) -> FilePath -> StateT ReaderState m ()
forall (m :: * -> *) a.
MonadError CompilerError m =>
FilePath -> m a
externalErrorS FilePath
e
        Maybe (Either FilePath Text)
Nothing -> FilePath -> StateT ReaderState m ()
forall (m :: * -> *) a.
MonadError CompilerError m =>
FilePath -> m a
externalErrorS (FilePath -> StateT ReaderState m ())
-> FilePath -> StateT ReaderState m ()
forall a b. (a -> b) -> a -> b
$ FilePath
fp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": file not found."
      where
        (FilePath
fp_name, FilePath
_) = FilePath -> (FilePath, FilePath)
Posix.splitExtension FilePath
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 :: [Name] -> [FilePath] -> m (Warnings, Imports, VNameSource)
readLibrary [Name]
extra_eps [FilePath]
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]
-> [FilePath]
-> [(ImportName, UncheckedProg)]
-> [(ImportName, UncheckedProg)]
setEntryPoints (Name
E.defaultEntryPoint Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
extra_eps) [FilePath]
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
=<< [FilePath] -> m [(ImportName, UncheckedProg)]
forall (m :: * -> *).
(MonadIO m, MonadError CompilerError m) =>
[FilePath] -> m [(ImportName, UncheckedProg)]
readUntypedLibrary [FilePath]
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 :: 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 :: [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