{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
-- | Facilities for reading Futhark test programs.  A Futhark test
-- program is an ordinary Futhark program where an initial comment
-- block specifies input- and output-sets.
module Futhark.Test
       ( testSpecFromFile
       , testSpecFromFileOrDie
       , testSpecsFromPaths
       , testSpecsFromPathsOrDie
       , valuesFromByteString
       , getValues
       , getValuesBS
       , compareValues
       , compareValues1
       , testRunReferenceOutput
       , getExpectedResult
       , compileProgram
       , runProgram
       , ensureReferenceOutput
       , determineTuning
       , binaryName
       , Mismatch

       , ProgramTest (..)
       , StructureTest (..)
       , StructurePipeline (..)
       , WarningTest (..)
       , TestAction (..)
       , ExpectedError (..)
       , InputOutputs (..)
       , TestRun (..)
       , ExpectedResult (..)
       , Success(..)
       , Values (..)
       , Value
       )
       where

import Control.Applicative
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString as SBS
import Control.Exception (catch)
import Control.Monad
import Control.Monad.Except
import qualified Data.Map.Strict as M
import Data.Char
import Data.Functor
import Data.Maybe
import Data.List (foldl')
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as T
import Data.Void
import System.FilePath
import Codec.Compression.GZip
import Codec.Compression.Zlib.Internal (DecompressError)
import qualified Control.Exception.Base as E

import Text.Megaparsec hiding (many, some)
import Text.Megaparsec.Char
import Text.Regex.TDFA
import System.Directory
import System.Exit
import System.Process.ByteString (readProcessWithExitCode)
import System.IO (withFile, IOMode(..), hFileSize, hClose)
import System.IO.Error
import System.IO.Temp

import Prelude

import Futhark.Analysis.Metrics
import Futhark.IR.Primitive
       (IntType(..), intValue, intByteSize,
        FloatType(..), floatValue, floatByteSize)
import Futhark.Test.Values
import Futhark.Util (directoryContents, pmapIO)
import Futhark.Util.Pretty (pretty, prettyText)
import Language.Futhark.Syntax (PrimType(..), PrimValue(..))
import Language.Futhark.Prop (primValueType, primByteSize)

-- | Description of a test to be carried out on a Futhark program.
-- The Futhark program is stored separately.
data ProgramTest =
  ProgramTest { ProgramTest -> Text
testDescription ::
                   T.Text
              , ProgramTest -> [Text]
testTags ::
                   [T.Text]
              , ProgramTest -> TestAction
testAction ::
                   TestAction
              }
  deriving (Int -> ProgramTest -> ShowS
[ProgramTest] -> ShowS
ProgramTest -> String
(Int -> ProgramTest -> ShowS)
-> (ProgramTest -> String)
-> ([ProgramTest] -> ShowS)
-> Show ProgramTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProgramTest] -> ShowS
$cshowList :: [ProgramTest] -> ShowS
show :: ProgramTest -> String
$cshow :: ProgramTest -> String
showsPrec :: Int -> ProgramTest -> ShowS
$cshowsPrec :: Int -> ProgramTest -> ShowS
Show)

-- | How to test a program.
data TestAction
  = CompileTimeFailure ExpectedError
  | RunCases [InputOutputs] [StructureTest] [WarningTest]
  deriving (Int -> TestAction -> ShowS
[TestAction] -> ShowS
TestAction -> String
(Int -> TestAction -> ShowS)
-> (TestAction -> String)
-> ([TestAction] -> ShowS)
-> Show TestAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestAction] -> ShowS
$cshowList :: [TestAction] -> ShowS
show :: TestAction -> String
$cshow :: TestAction -> String
showsPrec :: Int -> TestAction -> ShowS
$cshowsPrec :: Int -> TestAction -> ShowS
Show)

-- | Input and output pairs for some entry point(s).
data InputOutputs = InputOutputs { InputOutputs -> Text
iosEntryPoint :: T.Text
                                 , InputOutputs -> [TestRun]
iosTestRuns :: [TestRun] }
  deriving (Int -> InputOutputs -> ShowS
[InputOutputs] -> ShowS
InputOutputs -> String
(Int -> InputOutputs -> ShowS)
-> (InputOutputs -> String)
-> ([InputOutputs] -> ShowS)
-> Show InputOutputs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputOutputs] -> ShowS
$cshowList :: [InputOutputs] -> ShowS
show :: InputOutputs -> String
$cshow :: InputOutputs -> String
showsPrec :: Int -> InputOutputs -> ShowS
$cshowsPrec :: Int -> InputOutputs -> ShowS
Show)

-- | The error expected for a negative test.
data ExpectedError = AnyError
                   | ThisError T.Text Regex

instance Show ExpectedError where
  show :: ExpectedError -> String
show ExpectedError
AnyError = String
"AnyError"
  show (ThisError Text
r Regex
_) = String
"ThisError " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
r

-- | How a program can be transformed.
data StructurePipeline = KernelsPipeline
                       | SOACSPipeline
                       | SequentialCpuPipeline
                       | GpuPipeline
                       deriving (Int -> StructurePipeline -> ShowS
[StructurePipeline] -> ShowS
StructurePipeline -> String
(Int -> StructurePipeline -> ShowS)
-> (StructurePipeline -> String)
-> ([StructurePipeline] -> ShowS)
-> Show StructurePipeline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StructurePipeline] -> ShowS
$cshowList :: [StructurePipeline] -> ShowS
show :: StructurePipeline -> String
$cshow :: StructurePipeline -> String
showsPrec :: Int -> StructurePipeline -> ShowS
$cshowsPrec :: Int -> StructurePipeline -> ShowS
Show)

-- | A structure test specifies a compilation pipeline, as well as
-- metrics for the program coming out the other end.
data StructureTest = StructureTest StructurePipeline AstMetrics
                     deriving (Int -> StructureTest -> ShowS
[StructureTest] -> ShowS
StructureTest -> String
(Int -> StructureTest -> ShowS)
-> (StructureTest -> String)
-> ([StructureTest] -> ShowS)
-> Show StructureTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StructureTest] -> ShowS
$cshowList :: [StructureTest] -> ShowS
show :: StructureTest -> String
$cshow :: StructureTest -> String
showsPrec :: Int -> StructureTest -> ShowS
$cshowsPrec :: Int -> StructureTest -> ShowS
Show)

-- | A warning test requires that a warning matching the regular
-- expression is produced.  The program must also compile succesfully.
data WarningTest = ExpectedWarning T.Text Regex

instance Show WarningTest where
  show :: WarningTest -> String
show (ExpectedWarning Text
r Regex
_) = String
"ExpectedWarning " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
r

-- | A condition for execution, input, and expected result.
data TestRun = TestRun
               { TestRun -> [String]
runTags :: [String]
               , TestRun -> Values
runInput :: Values
               , TestRun -> ExpectedResult Success
runExpectedResult :: ExpectedResult Success
               , TestRun -> Int
runIndex :: Int
               , TestRun -> String
runDescription :: String
               }
             deriving (Int -> TestRun -> ShowS
[TestRun] -> ShowS
TestRun -> String
(Int -> TestRun -> ShowS)
-> (TestRun -> String) -> ([TestRun] -> ShowS) -> Show TestRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestRun] -> ShowS
$cshowList :: [TestRun] -> ShowS
show :: TestRun -> String
$cshow :: TestRun -> String
showsPrec :: Int -> TestRun -> ShowS
$cshowsPrec :: Int -> TestRun -> ShowS
Show)

-- | Several Values - either literally, or by reference to a file, or
-- to be generated on demand.
data Values = Values [Value]
            | InFile FilePath
            | GenValues [GenValue]
            deriving (Int -> Values -> ShowS
[Values] -> ShowS
Values -> String
(Int -> Values -> ShowS)
-> (Values -> String) -> ([Values] -> ShowS) -> Show Values
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Values] -> ShowS
$cshowList :: [Values] -> ShowS
show :: Values -> String
$cshow :: Values -> String
showsPrec :: Int -> Values -> ShowS
$cshowsPrec :: Int -> Values -> ShowS
Show)

data GenValue = GenValue [Int] PrimType
                -- ^ Generate a value of the given rank and primitive
                -- type.  Scalars are considered 0-ary arrays.
              | GenPrim PrimValue
                -- ^ A fixed non-randomised primitive value.
              deriving (Int -> GenValue -> ShowS
[GenValue] -> ShowS
GenValue -> String
(Int -> GenValue -> ShowS)
-> (GenValue -> String) -> ([GenValue] -> ShowS) -> Show GenValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenValue] -> ShowS
$cshowList :: [GenValue] -> ShowS
show :: GenValue -> String
$cshow :: GenValue -> String
showsPrec :: Int -> GenValue -> ShowS
$cshowsPrec :: Int -> GenValue -> ShowS
Show)

-- | A prettyprinted representation of type of value produced by a
-- 'GenValue'.
genValueType :: GenValue -> String
genValueType :: GenValue -> String
genValueType (GenValue [Int]
ds PrimType
t) =
  (Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
d -> String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]") [Int]
ds String -> ShowS
forall a. [a] -> [a] -> [a]
++ PrimType -> String
forall a. Pretty a => a -> String
pretty PrimType
t
genValueType (GenPrim PrimValue
v) =
  PrimValue -> String
forall a. Pretty a => a -> String
pretty PrimValue
v

-- | How a test case is expected to terminate.
data ExpectedResult values
  = Succeeds (Maybe values) -- ^ Execution suceeds, with or without
                            -- expected result values.
  | RunTimeFailure ExpectedError -- ^ Execution fails with this error.
  deriving (Int -> ExpectedResult values -> ShowS
[ExpectedResult values] -> ShowS
ExpectedResult values -> String
(Int -> ExpectedResult values -> ShowS)
-> (ExpectedResult values -> String)
-> ([ExpectedResult values] -> ShowS)
-> Show (ExpectedResult values)
forall values. Show values => Int -> ExpectedResult values -> ShowS
forall values. Show values => [ExpectedResult values] -> ShowS
forall values. Show values => ExpectedResult values -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedResult values] -> ShowS
$cshowList :: forall values. Show values => [ExpectedResult values] -> ShowS
show :: ExpectedResult values -> String
$cshow :: forall values. Show values => ExpectedResult values -> String
showsPrec :: Int -> ExpectedResult values -> ShowS
$cshowsPrec :: forall values. Show values => Int -> ExpectedResult values -> ShowS
Show)

-- | The result expected from a succesful execution.
data Success = SuccessValues Values
             -- ^ These values are expected.
             | SuccessGenerateValues
             -- ^ Compute expected values from executing a known-good
             -- reference implementation.
             deriving (Int -> Success -> ShowS
[Success] -> ShowS
Success -> String
(Int -> Success -> ShowS)
-> (Success -> String) -> ([Success] -> ShowS) -> Show Success
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Success] -> ShowS
$cshowList :: [Success] -> ShowS
show :: Success -> String
$cshow :: Success -> String
showsPrec :: Int -> Success -> ShowS
$cshowsPrec :: Int -> Success -> ShowS
Show)

type Parser = Parsec Void T.Text

lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme Parser a
p = Parser a
p Parser a -> ParsecT Void Text Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

-- Like 'lexeme', but does not consume trailing linebreaks.
lexeme' :: Parser a -> Parser a
lexeme' :: Parser a -> Parser a
lexeme' Parser a
p = Parser a
p Parser a -> ParsecT Void Text Identity String -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
" \t" :: String))

lexstr :: T.Text -> Parser ()
lexstr :: Text -> ParsecT Void Text Identity ()
lexstr = ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string

-- Like 'lexstr', but does not consume trailing linebreaks.
lexstr' :: T.Text -> Parser ()
lexstr' :: Text -> ParsecT Void Text Identity ()
lexstr' = ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme' (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string

braces :: Parser a -> Parser a
braces :: Parser a -> Parser a
braces Parser a
p = Text -> ParsecT Void Text Identity ()
lexstr Text
"{" ParsecT Void Text Identity () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> ParsecT Void Text Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParsecT Void Text Identity ()
lexstr Text
"}"

parseNatural :: Parser Int
parseNatural :: Parser Int
parseNatural = Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc Int
x -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) Int
0 ([Int] -> Int) -> (String -> [Int]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
num (String -> Int) -> ParsecT Void Text Identity String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
  where num :: Char -> Int
num Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'

parseDescription :: Parser T.Text
parseDescription :: ParsecT Void Text Identity Text
parseDescription = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT Void Text Identity ()
parseDescriptionSeparator)

parseDescriptionSeparator :: Parser ()
parseDescriptionSeparator :: ParsecT Void Text Identity ()
parseDescriptionSeparator = ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
descriptionSeparator ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                 ParsecT Void Text Identity String -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isSpace ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline)) ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

descriptionSeparator :: T.Text
descriptionSeparator :: Text
descriptionSeparator = Text
"=="

parseTags :: Parser [T.Text]
parseTags :: Parser [Text]
parseTags = Text -> ParsecT Void Text Identity ()
lexstr Text
"tags" ParsecT Void Text Identity () -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Text] -> Parser [Text]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity Text -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity Text
parseTag) Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text] -> Parser [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  where parseTag :: ParsecT Void Text Identity Text
parseTag = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
tagConstituent)

tagConstituent :: Char -> Bool
tagConstituent :: Char -> Bool
tagConstituent Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

parseAction :: Parser TestAction
parseAction :: Parser TestAction
parseAction = ExpectedError -> TestAction
CompileTimeFailure (ExpectedError -> TestAction)
-> ParsecT Void Text Identity ExpectedError -> Parser TestAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ParsecT Void Text Identity ()
lexstr' Text
"error:" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ExpectedError
-> ParsecT Void Text Identity ExpectedError
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ExpectedError
parseExpectedError) Parser TestAction -> Parser TestAction -> Parser TestAction
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              ([InputOutputs] -> [StructureTest] -> [WarningTest] -> TestAction
RunCases ([InputOutputs] -> [StructureTest] -> [WarningTest] -> TestAction)
-> ParsecT Void Text Identity [InputOutputs]
-> ParsecT
     Void Text Identity ([StructureTest] -> [WarningTest] -> TestAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [InputOutputs]
parseInputOutputs ParsecT
  Void Text Identity ([StructureTest] -> [WarningTest] -> TestAction)
-> ParsecT Void Text Identity [StructureTest]
-> ParsecT Void Text Identity ([WarningTest] -> TestAction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
               ParsecT Void Text Identity StructureTest
-> ParsecT Void Text Identity [StructureTest]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity StructureTest
parseExpectedStructure ParsecT Void Text Identity ([WarningTest] -> TestAction)
-> ParsecT Void Text Identity [WarningTest] -> Parser TestAction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity WarningTest
-> ParsecT Void Text Identity [WarningTest]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity WarningTest
parseWarning)

parseInputOutputs :: Parser [InputOutputs]
parseInputOutputs :: ParsecT Void Text Identity [InputOutputs]
parseInputOutputs = do
  [Text]
entrys <- Parser [Text]
parseEntryPoints
  [TestRun]
cases <- Parser [TestRun]
parseRunCases
  [InputOutputs] -> ParsecT Void Text Identity [InputOutputs]
forall (m :: * -> *) a. Monad m => a -> m a
return ([InputOutputs] -> ParsecT Void Text Identity [InputOutputs])
-> [InputOutputs] -> ParsecT Void Text Identity [InputOutputs]
forall a b. (a -> b) -> a -> b
$ (Text -> InputOutputs) -> [Text] -> [InputOutputs]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [TestRun] -> InputOutputs
`InputOutputs` [TestRun]
cases) [Text]
entrys

parseEntryPoints :: Parser [T.Text]
parseEntryPoints :: Parser [Text]
parseEntryPoints = (Text -> ParsecT Void Text Identity ()
lexstr Text
"entry:" ParsecT Void Text Identity () -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity Text
entry Parser [Text] -> ParsecT Void Text Identity () -> Parser [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text] -> Parser [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"main"]
  where constituent :: Char -> Bool
constituent Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}'
        entry :: ParsecT Void Text Identity Text
entry = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme' (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
constituent)

parseRunTags :: Parser [String]
parseRunTags :: Parser [String]
parseRunTags = ParsecT Void Text Identity String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity String
parseTag
  where parseTag :: ParsecT Void Text Identity String
parseTag = ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity String
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity String
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ do String
s <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
tagConstituent
                                     Bool -> ParsecT Void Text Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Void Text Identity ())
-> Bool -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"input", String
"structure", String
"warning"]
                                     String -> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

parseRunCases :: Parser [TestRun]
parseRunCases :: Parser [TestRun]
parseRunCases = Int -> Parser [TestRun]
parseRunCases' (Int
0::Int)
  where parseRunCases' :: Int -> Parser [TestRun]
parseRunCases' Int
i = (:) (TestRun -> [TestRun] -> [TestRun])
-> ParsecT Void Text Identity TestRun
-> ParsecT Void Text Identity ([TestRun] -> [TestRun])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Void Text Identity TestRun
parseRunCase Int
i ParsecT Void Text Identity ([TestRun] -> [TestRun])
-> Parser [TestRun] -> Parser [TestRun]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser [TestRun]
parseRunCases' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                           Parser [TestRun] -> Parser [TestRun] -> Parser [TestRun]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [TestRun] -> Parser [TestRun]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        parseRunCase :: Int -> ParsecT Void Text Identity TestRun
parseRunCase Int
i = do
          [String]
tags <- Parser [String]
parseRunTags
          Text -> ParsecT Void Text Identity ()
lexstr Text
"input"
          Values
input <- if String
"random" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
tags
                   then Parser Values
parseRandomValues
                   else Parser Values
parseValues
          ExpectedResult Success
expr <- Parser (ExpectedResult Success)
parseExpectedResult
          TestRun -> ParsecT Void Text Identity TestRun
forall (m :: * -> *) a. Monad m => a -> m a
return (TestRun -> ParsecT Void Text Identity TestRun)
-> TestRun -> ParsecT Void Text Identity TestRun
forall a b. (a -> b) -> a -> b
$ [String]
-> Values -> ExpectedResult Success -> Int -> String -> TestRun
TestRun [String]
tags Values
input ExpectedResult Success
expr Int
i (String -> TestRun) -> String -> TestRun
forall a b. (a -> b) -> a -> b
$ Int -> Values -> String
forall a. Show a => a -> Values -> String
desc Int
i Values
input

        -- If the file is gzipped, we strip the 'gz' extension from
        -- the dataset name.  This makes it more convenient to rename
        -- from 'foo.in' to 'foo.in.gz', as the reported dataset name
        -- does not change (which would make comparisons to historical
        -- data harder).
        desc :: a -> Values -> String
desc a
_ (InFile String
path)
          | ShowS
takeExtension String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".gz" = ShowS
dropExtension String
path
          | Bool
otherwise                   = String
path
        desc a
i (Values [Value]
vs) =
          -- Turn linebreaks into space.
          String
"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (String -> [String]
lines String
vs') String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\")"
          where vs' :: String
vs' = case [String] -> String
unwords ((Value -> String) -> [Value] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Value -> String
forall a. Pretty a => a -> String
pretty [Value]
vs) of
                        String
s | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
50 -> Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
50 String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"..."
                          | Bool
otherwise     -> String
s
        desc a
_ (GenValues [GenValue]
gens) =
          [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (GenValue -> String) -> [GenValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GenValue -> String
genValueType [GenValue]
gens

parseExpectedResult :: Parser (ExpectedResult Success)
parseExpectedResult :: Parser (ExpectedResult Success)
parseExpectedResult =
  (Text -> ParsecT Void Text Identity ()
lexstr Text
"auto" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Void Text Identity ()
lexstr Text
"output" ParsecT Void Text Identity ()
-> ExpectedResult Success -> Parser (ExpectedResult Success)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Success -> ExpectedResult Success
forall values. Maybe values -> ExpectedResult values
Succeeds (Success -> Maybe Success
forall a. a -> Maybe a
Just Success
SuccessGenerateValues)) Parser (ExpectedResult Success)
-> Parser (ExpectedResult Success)
-> Parser (ExpectedResult Success)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Maybe Success -> ExpectedResult Success
forall values. Maybe values -> ExpectedResult values
Succeeds (Maybe Success -> ExpectedResult Success)
-> (Values -> Maybe Success) -> Values -> ExpectedResult Success
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Success -> Maybe Success
forall a. a -> Maybe a
Just (Success -> Maybe Success)
-> (Values -> Success) -> Values -> Maybe Success
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> Success
SuccessValues (Values -> ExpectedResult Success)
-> Parser Values -> Parser (ExpectedResult Success)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ParsecT Void Text Identity ()
lexstr Text
"output" ParsecT Void Text Identity () -> Parser Values -> Parser Values
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Values
parseValues)) Parser (ExpectedResult Success)
-> Parser (ExpectedResult Success)
-> Parser (ExpectedResult Success)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (ExpectedError -> ExpectedResult Success
forall values. ExpectedError -> ExpectedResult values
RunTimeFailure (ExpectedError -> ExpectedResult Success)
-> ParsecT Void Text Identity ExpectedError
-> Parser (ExpectedResult Success)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ParsecT Void Text Identity ()
lexstr Text
"error:" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ExpectedError
-> ParsecT Void Text Identity ExpectedError
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ExpectedError
parseExpectedError)) Parser (ExpectedResult Success)
-> Parser (ExpectedResult Success)
-> Parser (ExpectedResult Success)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  ExpectedResult Success -> Parser (ExpectedResult Success)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Success -> ExpectedResult Success
forall values. Maybe values -> ExpectedResult values
Succeeds Maybe Success
forall a. Maybe a
Nothing)

parseExpectedError :: Parser ExpectedError
parseExpectedError :: ParsecT Void Text Identity ExpectedError
parseExpectedError = ParsecT Void Text Identity ExpectedError
-> ParsecT Void Text Identity ExpectedError
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity ExpectedError
 -> ParsecT Void Text Identity ExpectedError)
-> ParsecT Void Text Identity ExpectedError
-> ParsecT Void Text Identity ExpectedError
forall a b. (a -> b) -> a -> b
$ do
  Text
s <- Text -> Text
T.strip (Text -> Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
restOfLine
  if Text -> Bool
T.null Text
s
    then ExpectedError -> ParsecT Void Text Identity ExpectedError
forall (m :: * -> *) a. Monad m => a -> m a
return ExpectedError
AnyError
         -- blankCompOpt creates a regular expression that treats
         -- newlines like ordinary characters, which is what we want.
    else Text -> Regex -> ExpectedError
ThisError Text
s (Regex -> ExpectedError)
-> ParsecT Void Text Identity Regex
-> ParsecT Void Text Identity ExpectedError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompOption
-> ExecOption -> String -> ParsecT Void Text Identity Regex
forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
makeRegexOptsM CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
blankCompOpt ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt (Text -> String
T.unpack Text
s)

parseRandomValues :: Parser Values
parseRandomValues :: Parser Values
parseRandomValues = [GenValue] -> Values
GenValues ([GenValue] -> Values)
-> ParsecT Void Text Identity [GenValue] -> Parser Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [GenValue]
-> ParsecT Void Text Identity [GenValue]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> ParsecT Void Text Identity ()
lexstr Text
"{") (Text -> ParsecT Void Text Identity ()
lexstr Text
"}") (ParsecT Void Text Identity GenValue
-> ParsecT Void Text Identity [GenValue]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity GenValue
parseGenValue)

parseGenValue :: Parser GenValue
parseGenValue :: ParsecT Void Text Identity GenValue
parseGenValue = [ParsecT Void Text Identity GenValue]
-> ParsecT Void Text Identity GenValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ [Int] -> PrimType -> GenValue
GenValue ([Int] -> PrimType -> GenValue)
-> ParsecT Void Text Identity [Int]
-> ParsecT Void Text Identity (PrimType -> GenValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> ParsecT Void Text Identity [Int]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Int
dim ParsecT Void Text Identity (PrimType -> GenValue)
-> ParsecT Void Text Identity PrimType
-> ParsecT Void Text Identity GenValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity PrimType
parsePrimType
                       , ParsecT Void Text Identity GenValue
-> ParsecT Void Text Identity GenValue
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity GenValue
 -> ParsecT Void Text Identity GenValue)
-> ParsecT Void Text Identity GenValue
-> ParsecT Void Text Identity GenValue
forall a b. (a -> b) -> a -> b
$ PrimValue -> GenValue
GenPrim (PrimValue -> GenValue)
-> ParsecT Void Text Identity PrimValue
-> ParsecT Void Text Identity GenValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void Text Identity PrimValue]
-> ParsecT Void Text Identity PrimValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT Void Text Identity PrimValue
i8, ParsecT Void Text Identity PrimValue
i16, ParsecT Void Text Identity PrimValue
i32, ParsecT Void Text Identity PrimValue
i64,
                                                      ParsecT Void Text Identity PrimValue
u8, ParsecT Void Text Identity PrimValue
u16, ParsecT Void Text Identity PrimValue
u32, ParsecT Void Text Identity PrimValue
u64,
                                                      ParsecT Void Text Identity PrimValue
f32, ParsecT Void Text Identity PrimValue
f64,
                                                      (IntValue -> PrimValue)
-> IntType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(IntValue -> a) -> IntType -> Text -> ParsecT Void Text Identity a
int IntValue -> PrimValue
SignedValue IntType
Int32 Text
""]
                       ]
  where digits :: ParsecT Void Text Identity String
digits = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isDigit)
        dim :: Parser Int
dim = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> Parser Int -> Parser Int
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> ParsecT Void Text Identity ()
lexstr Text
"[") (Text -> ParsecT Void Text Identity ()
lexstr Text
"]") (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
              Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ParsecT Void Text Identity String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
digits

        readint :: String -> Integer
        readint :: String -> Integer
readint = String -> Integer
forall a. Read a => String -> a
read -- To avoid warnings.

        readfloat :: String -> Double
        readfloat :: String -> Double
readfloat = String -> Double
forall a. Read a => String -> a
read -- To avoid warnings.

        int :: (IntValue -> a) -> IntType -> Text -> ParsecT Void Text Identity a
int IntValue -> a
f IntType
t Text
s = ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity a -> ParsecT Void Text Identity a)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity a -> ParsecT Void Text Identity a)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a b. (a -> b) -> a -> b
$ IntValue -> a
f (IntValue -> a) -> (String -> IntValue) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t  (Integer -> IntValue) -> (String -> Integer) -> String -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer
readint (String -> a)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
digits ParsecT Void Text Identity a
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                    Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
s ParsecT Void Text Identity a
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                    ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
        i8 :: ParsecT Void Text Identity PrimValue
i8  = (IntValue -> PrimValue)
-> IntType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(IntValue -> a) -> IntType -> Text -> ParsecT Void Text Identity a
int IntValue -> PrimValue
SignedValue IntType
Int8 Text
"i8"
        i16 :: ParsecT Void Text Identity PrimValue
i16 = (IntValue -> PrimValue)
-> IntType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(IntValue -> a) -> IntType -> Text -> ParsecT Void Text Identity a
int IntValue -> PrimValue
SignedValue IntType
Int16 Text
"i16"
        i32 :: ParsecT Void Text Identity PrimValue
i32 = (IntValue -> PrimValue)
-> IntType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(IntValue -> a) -> IntType -> Text -> ParsecT Void Text Identity a
int IntValue -> PrimValue
SignedValue IntType
Int32 Text
"i32"
        i64 :: ParsecT Void Text Identity PrimValue
i64 = (IntValue -> PrimValue)
-> IntType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(IntValue -> a) -> IntType -> Text -> ParsecT Void Text Identity a
int IntValue -> PrimValue
SignedValue IntType
Int64 Text
"i64"
        u8 :: ParsecT Void Text Identity PrimValue
u8  = (IntValue -> PrimValue)
-> IntType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(IntValue -> a) -> IntType -> Text -> ParsecT Void Text Identity a
int IntValue -> PrimValue
UnsignedValue IntType
Int8 Text
"u8"
        u16 :: ParsecT Void Text Identity PrimValue
u16 = (IntValue -> PrimValue)
-> IntType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(IntValue -> a) -> IntType -> Text -> ParsecT Void Text Identity a
int IntValue -> PrimValue
UnsignedValue IntType
Int16 Text
"u16"
        u32 :: ParsecT Void Text Identity PrimValue
u32 = (IntValue -> PrimValue)
-> IntType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(IntValue -> a) -> IntType -> Text -> ParsecT Void Text Identity a
int IntValue -> PrimValue
UnsignedValue IntType
Int32 Text
"u32"
        u64 :: ParsecT Void Text Identity PrimValue
u64 = (IntValue -> PrimValue)
-> IntType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(IntValue -> a) -> IntType -> Text -> ParsecT Void Text Identity a
int IntValue -> PrimValue
UnsignedValue IntType
Int64 Text
"u64"

        optSuffix :: m b -> m b -> m b
optSuffix m b
s m b
suff = do
          b
s' <- m b
s
          ((b
s'b -> b -> b
forall a. Semigroup a => a -> a -> a
<>) (b -> b) -> m b -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
suff) m b -> m b -> m b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
s'

        float :: (FloatValue -> a)
-> FloatType -> Text -> ParsecT Void Text Identity a
float FloatValue -> a
f FloatType
t Text
s = ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity a -> ParsecT Void Text Identity a)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity a -> ParsecT Void Text Identity a)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a b. (a -> b) -> a -> b
$ FloatValue -> a
f (FloatValue -> a) -> (String -> FloatValue) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatType -> Double -> FloatValue
forall num. Real num => FloatType -> num -> FloatValue
floatValue FloatType
t  (Double -> FloatValue)
-> (String -> Double) -> String -> FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double
readfloat (String -> a)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                      (ParsecT Void Text Identity String
digits ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (m :: * -> *) b.
(Monad m, Alternative m, Semigroup b) =>
m b -> m b -> m b
`optSuffix` (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((String
"."String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
digits))) ParsecT Void Text Identity a
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                      Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
s ParsecT Void Text Identity a
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                      ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlphaNum)
        f32 :: ParsecT Void Text Identity PrimValue
f32 = (FloatValue -> PrimValue)
-> FloatType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(FloatValue -> a)
-> FloatType -> Text -> ParsecT Void Text Identity a
float FloatValue -> PrimValue
FloatValue FloatType
Float32 Text
"f32"
        f64 :: ParsecT Void Text Identity PrimValue
f64 = (FloatValue -> PrimValue)
-> FloatType -> Text -> ParsecT Void Text Identity PrimValue
forall a.
(FloatValue -> a)
-> FloatType -> Text -> ParsecT Void Text Identity a
float FloatValue -> PrimValue
FloatValue FloatType
Float64 Text
"f64"

parsePrimType :: Parser PrimType
parsePrimType :: ParsecT Void Text Identity PrimType
parsePrimType =
  [ParsecT Void Text Identity PrimType]
-> ParsecT Void Text Identity PrimType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ Text -> ParsecT Void Text Identity ()
lexstr Text
"i8" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
Signed IntType
Int8
         , Text -> ParsecT Void Text Identity ()
lexstr Text
"i16" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
Signed IntType
Int16
         , Text -> ParsecT Void Text Identity ()
lexstr Text
"i32" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
Signed IntType
Int32
         , Text -> ParsecT Void Text Identity ()
lexstr Text
"i64" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
Signed IntType
Int64
         , Text -> ParsecT Void Text Identity ()
lexstr Text
"u8" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
Unsigned IntType
Int8
         , Text -> ParsecT Void Text Identity ()
lexstr Text
"u16" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
Unsigned IntType
Int16
         , Text -> ParsecT Void Text Identity ()
lexstr Text
"u32" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
Unsigned IntType
Int32
         , Text -> ParsecT Void Text Identity ()
lexstr Text
"u64" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
Unsigned IntType
Int64
         , Text -> ParsecT Void Text Identity ()
lexstr Text
"f32" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatType -> PrimType
FloatType FloatType
Float32
         , Text -> ParsecT Void Text Identity ()
lexstr Text
"f64" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatType -> PrimType
FloatType FloatType
Float64
         , Text -> ParsecT Void Text Identity ()
lexstr Text
"bool" ParsecT Void Text Identity ()
-> PrimType -> ParsecT Void Text Identity PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
Bool
         ]

parseValues :: Parser Values
parseValues :: Parser Values
parseValues = do Text
s <- ParsecT Void Text Identity Text
parseBlock
                 case String -> ByteString -> Either String [Value]
valuesFromByteString String
"input block contents" (ByteString -> Either String [Value])
-> ByteString -> Either String [Value]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
s of
                   Left String
err -> String -> Parser Values
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
                   Right [Value]
vs -> Values -> Parser Values
forall (m :: * -> *) a. Monad m => a -> m a
return (Values -> Parser Values) -> Values -> Parser Values
forall a b. (a -> b) -> a -> b
$ [Value] -> Values
Values [Value]
vs
              Parser Values -> Parser Values -> Parser Values
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ParsecT Void Text Identity ()
lexstr Text
"@" ParsecT Void Text Identity () -> Parser Values -> Parser Values
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Values -> Parser Values
forall a. Parser a -> Parser a
lexeme (String -> Values
InFile (String -> Values) -> (Text -> String) -> Text -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Values)
-> ParsecT Void Text Identity Text -> Parser Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
nextWord)

parseBlock :: Parser T.Text
parseBlock :: ParsecT Void Text Identity Text
parseBlock = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
braces (String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Void Text Identity String
parseBlockBody Int
0)

parseBlockBody :: Int -> Parser String
parseBlockBody :: Int -> ParsecT Void Text Identity String
parseBlockBody Int
n = do
  Char
c <- ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
  case (Char
c,Int
n) of
    (Char
'}', Int
0) -> String -> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
forall a. Monoid a => a
mempty
    (Char
'}', Int
_) -> (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ParsecT Void Text Identity String
parseBlockBody (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    (Char
'{', Int
_) -> (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ParsecT Void Text Identity String
parseBlockBody (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    (Char, Int)
_        -> (:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ParsecT Void Text Identity String
parseBlockBody Int
n

restOfLine :: Parser T.Text
restOfLine :: ParsecT Void Text Identity Text
restOfLine = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof))

nextWord :: Parser T.Text
nextWord :: ParsecT Void Text Identity Text
nextWord = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isSpace)

parseWarning :: Parser WarningTest
parseWarning :: ParsecT Void Text Identity WarningTest
parseWarning = Text -> ParsecT Void Text Identity ()
lexstr Text
"warning:" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity WarningTest
-> ParsecT Void Text Identity WarningTest
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity WarningTest
parseExpectedWarning
  where parseExpectedWarning :: ParsecT Void Text Identity WarningTest
parseExpectedWarning = ParsecT Void Text Identity WarningTest
-> ParsecT Void Text Identity WarningTest
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity WarningTest
 -> ParsecT Void Text Identity WarningTest)
-> ParsecT Void Text Identity WarningTest
-> ParsecT Void Text Identity WarningTest
forall a b. (a -> b) -> a -> b
$ do
          Text
s <- Text -> Text
T.strip (Text -> Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
restOfLine
          Text -> Regex -> WarningTest
ExpectedWarning Text
s (Regex -> WarningTest)
-> ParsecT Void Text Identity Regex
-> ParsecT Void Text Identity WarningTest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompOption
-> ExecOption -> String -> ParsecT Void Text Identity Regex
forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
makeRegexOptsM CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
blankCompOpt ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt (Text -> String
T.unpack Text
s)

parseExpectedStructure :: Parser StructureTest
parseExpectedStructure :: ParsecT Void Text Identity StructureTest
parseExpectedStructure =
  Text -> ParsecT Void Text Identity ()
lexstr Text
"structure" ParsecT Void Text Identity ()
-> ParsecT Void Text Identity StructureTest
-> ParsecT Void Text Identity StructureTest
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
  (StructurePipeline -> AstMetrics -> StructureTest
StructureTest (StructurePipeline -> AstMetrics -> StructureTest)
-> ParsecT Void Text Identity StructurePipeline
-> ParsecT Void Text Identity (AstMetrics -> StructureTest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity StructurePipeline
optimisePipeline ParsecT Void Text Identity (AstMetrics -> StructureTest)
-> ParsecT Void Text Identity AstMetrics
-> ParsecT Void Text Identity StructureTest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity AstMetrics
parseMetrics)

optimisePipeline :: Parser StructurePipeline
optimisePipeline :: ParsecT Void Text Identity StructurePipeline
optimisePipeline = Text -> ParsecT Void Text Identity ()
lexstr Text
"distributed" ParsecT Void Text Identity ()
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
KernelsPipeline ParsecT Void Text Identity StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                   Text -> ParsecT Void Text Identity ()
lexstr Text
"gpu" ParsecT Void Text Identity ()
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
GpuPipeline ParsecT Void Text Identity StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                   Text -> ParsecT Void Text Identity ()
lexstr Text
"cpu" ParsecT Void Text Identity ()
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
SequentialCpuPipeline ParsecT Void Text Identity StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                   StructurePipeline -> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a. Applicative f => a -> f a
pure StructurePipeline
SOACSPipeline

parseMetrics :: Parser AstMetrics
parseMetrics :: ParsecT Void Text Identity AstMetrics
parseMetrics = ParsecT Void Text Identity AstMetrics
-> ParsecT Void Text Identity AstMetrics
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity AstMetrics
 -> ParsecT Void Text Identity AstMetrics)
-> ParsecT Void Text Identity AstMetrics
-> ParsecT Void Text Identity AstMetrics
forall a b. (a -> b) -> a -> b
$ ([(Text, Int)] -> AstMetrics)
-> ParsecT Void Text Identity [(Text, Int)]
-> ParsecT Void Text Identity AstMetrics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Text Int -> AstMetrics
AstMetrics (Map Text Int -> AstMetrics)
-> ([(Text, Int)] -> Map Text Int) -> [(Text, Int)] -> AstMetrics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Int)] -> Map Text Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList) (ParsecT Void Text Identity [(Text, Int)]
 -> ParsecT Void Text Identity AstMetrics)
-> ParsecT Void Text Identity [(Text, Int)]
-> ParsecT Void Text Identity AstMetrics
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (Text, Int)
-> ParsecT Void Text Identity [(Text, Int)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity (Text, Int)
 -> ParsecT Void Text Identity [(Text, Int)])
-> ParsecT Void Text Identity (Text, Int)
-> ParsecT Void Text Identity [(Text, Int)]
forall a b. (a -> b) -> a -> b
$
               (,) (Text -> Int -> (Text, Int))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Int -> (Text, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
constituent))) ParsecT Void Text Identity (Int -> (Text, Int))
-> Parser Int -> ParsecT Void Text Identity (Text, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
parseNatural
  where constituent :: Char -> Bool
constituent Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'

testSpec :: Parser ProgramTest
testSpec :: Parser ProgramTest
testSpec =
  Text -> [Text] -> TestAction -> ProgramTest
ProgramTest (Text -> [Text] -> TestAction -> ProgramTest)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ([Text] -> TestAction -> ProgramTest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
parseDescription ParsecT Void Text Identity ([Text] -> TestAction -> ProgramTest)
-> Parser [Text]
-> ParsecT Void Text Identity (TestAction -> ProgramTest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Text]
parseTags ParsecT Void Text Identity (TestAction -> ProgramTest)
-> Parser TestAction -> Parser ProgramTest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TestAction
parseAction

parserState :: Int -> FilePath -> s -> State s e
parserState :: Int -> String -> s -> State s e
parserState Int
line String
name s
t =
  State :: forall s e. s -> Int -> PosState s -> [ParseError s e] -> State s e
State { stateInput :: s
stateInput = s
t
        , stateOffset :: Int
stateOffset = Int
0
        , statePosState :: PosState s
statePosState = PosState :: forall s. s -> Int -> SourcePos -> Pos -> String -> PosState s
PosState
          { pstateInput :: s
pstateInput = s
t
          , pstateOffset :: Int
pstateOffset = Int
0
          , pstateSourcePos :: SourcePos
pstateSourcePos = SourcePos :: String -> Pos -> Pos -> SourcePos
SourcePos
                              { sourceName :: String
sourceName = String
name
                              , sourceLine :: Pos
sourceLine = Int -> Pos
mkPos Int
line
                              , sourceColumn :: Pos
sourceColumn = Int -> Pos
mkPos Int
3 }
          , pstateTabWidth :: Pos
pstateTabWidth = Pos
defaultTabWidth
          , pstateLinePrefix :: String
pstateLinePrefix = String
"-- "}
        , stateParseErrors :: [ParseError s e]
stateParseErrors = []
        }


readTestSpec :: Int -> String -> T.Text -> Either (ParseErrorBundle T.Text Void) ProgramTest
readTestSpec :: Int
-> String
-> Text
-> Either (ParseErrorBundle Text Void) ProgramTest
readTestSpec Int
line String
name Text
t =
  (State Text Void, Either (ParseErrorBundle Text Void) ProgramTest)
-> Either (ParseErrorBundle Text Void) ProgramTest
forall a b. (a, b) -> b
snd ((State Text Void, Either (ParseErrorBundle Text Void) ProgramTest)
 -> Either (ParseErrorBundle Text Void) ProgramTest)
-> (State Text Void,
    Either (ParseErrorBundle Text Void) ProgramTest)
-> Either (ParseErrorBundle Text Void) ProgramTest
forall a b. (a -> b) -> a -> b
$ Parser ProgramTest
-> State Text Void
-> (State Text Void,
    Either (ParseErrorBundle Text Void) ProgramTest)
forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
runParser' (Parser ProgramTest
testSpec Parser ProgramTest
-> ParsecT Void Text Identity () -> Parser ProgramTest
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) (State Text Void
 -> (State Text Void,
     Either (ParseErrorBundle Text Void) ProgramTest))
-> State Text Void
-> (State Text Void,
    Either (ParseErrorBundle Text Void) ProgramTest)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Text -> State Text Void
forall s e. Int -> String -> s -> State s e
parserState Int
line String
name Text
t

readInputOutputs :: Int -> String -> T.Text -> Either (ParseErrorBundle T.Text Void) [InputOutputs]
readInputOutputs :: Int
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [InputOutputs]
readInputOutputs Int
line String
name Text
t =
  (State Text Void,
 Either (ParseErrorBundle Text Void) [InputOutputs])
-> Either (ParseErrorBundle Text Void) [InputOutputs]
forall a b. (a, b) -> b
snd ((State Text Void,
  Either (ParseErrorBundle Text Void) [InputOutputs])
 -> Either (ParseErrorBundle Text Void) [InputOutputs])
-> (State Text Void,
    Either (ParseErrorBundle Text Void) [InputOutputs])
-> Either (ParseErrorBundle Text Void) [InputOutputs]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity [InputOutputs]
-> State Text Void
-> (State Text Void,
    Either (ParseErrorBundle Text Void) [InputOutputs])
forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
runParser' (ParsecT Void Text Identity Text
parseDescription ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [InputOutputs]
-> ParsecT Void Text Identity [InputOutputs]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity [InputOutputs]
parseInputOutputs ParsecT Void Text Identity [InputOutputs]
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [InputOutputs]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) (State Text Void
 -> (State Text Void,
     Either (ParseErrorBundle Text Void) [InputOutputs]))
-> State Text Void
-> (State Text Void,
    Either (ParseErrorBundle Text Void) [InputOutputs])
forall a b. (a -> b) -> a -> b
$
  Int -> String -> Text -> State Text Void
forall s e. Int -> String -> s -> State s e
parserState Int
line String
name Text
t

commentPrefix :: T.Text
commentPrefix :: Text
commentPrefix = String -> Text
T.pack String
"--"

couldNotRead :: IOError -> IO (Either String a)
couldNotRead :: IOError -> IO (Either String a)
couldNotRead = Either String a -> IO (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> (IOError -> Either String a) -> IOError -> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a)
-> (IOError -> String) -> IOError -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> String
forall a. Show a => a -> String
show

-- | Read the test specification from the given Futhark program.
testSpecFromFile :: FilePath -> IO (Either String ProgramTest)
testSpecFromFile :: String -> IO (Either String ProgramTest)
testSpecFromFile String
path = do
  Either String [(Int, Text)]
blocks_or_err <-
    ([(Int, Text)] -> Either String [(Int, Text)]
forall a b. b -> Either a b
Right ([(Int, Text)] -> Either String [(Int, Text)])
-> (Text -> [(Int, Text)]) -> Text -> Either String [(Int, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Int, Text)]
testBlocks (Text -> Either String [(Int, Text)])
-> IO Text -> IO (Either String [(Int, Text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
path)
    IO (Either String [(Int, Text)])
-> (IOError -> IO (Either String [(Int, Text)]))
-> IO (Either String [(Int, Text)])
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO (Either String [(Int, Text)])
forall a. IOError -> IO (Either String a)
couldNotRead
  case Either String [(Int, Text)]
blocks_or_err of
    Left String
err -> Either String ProgramTest -> IO (Either String ProgramTest)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ProgramTest -> IO (Either String ProgramTest))
-> Either String ProgramTest -> IO (Either String ProgramTest)
forall a b. (a -> b) -> a -> b
$ String -> Either String ProgramTest
forall a b. a -> Either a b
Left String
err
    Right [(Int, Text)]
blocks -> do
      let (Int
first_spec_line, Text
first_spec, [(Int, Text)]
rest_specs) =
            case [(Int, Text)]
blocks of []       -> (Int
0, Text
forall a. Monoid a => a
mempty, [])
                           (Int
n,Text
s):[(Int, Text)]
ss -> (Int
n, Text
s, [(Int, Text)]
ss)
      case Int
-> String
-> Text
-> Either (ParseErrorBundle Text Void) ProgramTest
readTestSpec (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
first_spec_line) String
path Text
first_spec of
        Left ParseErrorBundle Text Void
err -> Either String ProgramTest -> IO (Either String ProgramTest)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ProgramTest -> IO (Either String ProgramTest))
-> Either String ProgramTest -> IO (Either String ProgramTest)
forall a b. (a -> b) -> a -> b
$ String -> Either String ProgramTest
forall a b. a -> Either a b
Left (String -> Either String ProgramTest)
-> String -> Either String ProgramTest
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
err
        Right ProgramTest
v  -> Either String ProgramTest -> IO (Either String ProgramTest)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ProgramTest -> IO (Either String ProgramTest))
-> Either String ProgramTest -> IO (Either String ProgramTest)
forall a b. (a -> b) -> a -> b
$ (ProgramTest -> (Int, Text) -> Either String ProgramTest)
-> ProgramTest -> [(Int, Text)] -> Either String ProgramTest
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ProgramTest -> (Int, Text) -> Either String ProgramTest
moreCases ProgramTest
v [(Int, Text)]
rest_specs

  where moreCases :: ProgramTest -> (Int, Text) -> Either String ProgramTest
moreCases ProgramTest
test (Int
lineno, Text
cases) =
          case Int
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [InputOutputs]
readInputOutputs Int
lineno String
path Text
cases of
            Left ParseErrorBundle Text Void
err     -> String -> Either String ProgramTest
forall a b. a -> Either a b
Left (String -> Either String ProgramTest)
-> String -> Either String ProgramTest
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
err
            Right [InputOutputs]
cases' ->
              case ProgramTest -> TestAction
testAction ProgramTest
test of
                RunCases [InputOutputs]
old_cases [StructureTest]
structures [WarningTest]
warnings ->
                  ProgramTest -> Either String ProgramTest
forall a b. b -> Either a b
Right ProgramTest
test { testAction :: TestAction
testAction = [InputOutputs] -> [StructureTest] -> [WarningTest] -> TestAction
RunCases ([InputOutputs]
old_cases [InputOutputs] -> [InputOutputs] -> [InputOutputs]
forall a. [a] -> [a] -> [a]
++ [InputOutputs]
cases') [StructureTest]
structures [WarningTest]
warnings }
                TestAction
_ -> String -> Either String ProgramTest
forall a b. a -> Either a b
Left String
"Secondary test block provided, but primary test block specifies compilation error."

-- | Like 'testSpecFromFile', but kills the process on error.
testSpecFromFileOrDie :: FilePath -> IO ProgramTest
testSpecFromFileOrDie :: String -> IO ProgramTest
testSpecFromFileOrDie String
prog = do
  Either String ProgramTest
spec_or_err <- String -> IO (Either String ProgramTest)
testSpecFromFile String
prog
  case Either String ProgramTest
spec_or_err of
    Left String
err -> do String -> IO ()
putStrLn String
err
                   IO ProgramTest
forall a. IO a
exitFailure
    Right ProgramTest
spec -> ProgramTest -> IO ProgramTest
forall (m :: * -> *) a. Monad m => a -> m a
return ProgramTest
spec

testBlocks :: T.Text -> [(Int, T.Text)]
testBlocks :: Text -> [(Int, Text)]
testBlocks = ((Int, [Text]) -> Maybe (Int, Text))
-> [(Int, [Text])] -> [(Int, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int, [Text]) -> Maybe (Int, Text)
forall a. (a, [Text]) -> Maybe (a, Text)
isTestBlock ([(Int, [Text])] -> [(Int, Text)])
-> (Text -> [(Int, [Text])]) -> Text -> [(Int, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Int, [Text])]
commentBlocks
  where isTestBlock :: (a, [Text]) -> Maybe (a, Text)
isTestBlock (a
n,[Text]
block)
          | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
descriptionSeparator) Text -> Text -> Bool
`T.isPrefixOf`) [Text]
block =
              (a, Text) -> Maybe (a, Text)
forall a. a -> Maybe a
Just (a
n, [Text] -> Text
T.unlines [Text]
block)
          | Bool
otherwise =
              Maybe (a, Text)
forall a. Maybe a
Nothing

commentBlocks :: T.Text -> [(Int, [T.Text])]
commentBlocks :: Text -> [(Int, [Text])]
commentBlocks = [(Int, Text)] -> [(Int, [Text])]
forall a. [(a, Text)] -> [(a, [Text])]
commentBlocks' ([(Int, Text)] -> [(Int, [Text])])
-> (Text -> [(Int, Text)]) -> Text -> [(Int, [Text])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Text] -> [(Int, Text)])
-> (Text -> [Text]) -> Text -> [(Int, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
  where isComment :: Text -> Bool
isComment = (Text
commentPrefix Text -> Text -> Bool
`T.isPrefixOf`)
        commentBlocks' :: [(a, Text)] -> [(a, [Text])]
commentBlocks' [(a, Text)]
ls =
          let ls' :: [(a, Text)]
ls' = ((a, Text) -> Bool) -> [(a, Text)] -> [(a, Text)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> ((a, Text) -> Bool) -> (a, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isComment (Text -> Bool) -> ((a, Text) -> Text) -> (a, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Text) -> Text
forall a b. (a, b) -> b
snd) [(a, Text)]
ls
          in case [(a, Text)]
ls' of
            [] -> []
            (a
n,Text
_) : [(a, Text)]
_ ->
              let ([(a, Text)]
block, [(a, Text)]
ls'') = ((a, Text) -> Bool) -> [(a, Text)] -> ([(a, Text)], [(a, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Text -> Bool
isComment (Text -> Bool) -> ((a, Text) -> Text) -> (a, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Text) -> Text
forall a b. (a, b) -> b
snd) [(a, Text)]
ls'
                  block' :: [Text]
block' = ((a, Text) -> Text) -> [(a, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.drop Int
2 (Text -> Text) -> ((a, Text) -> Text) -> (a, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Text) -> Text
forall a b. (a, b) -> b
snd) [(a, Text)]
block
              in (a
n, [Text]
block') (a, [Text]) -> [(a, [Text])] -> [(a, [Text])]
forall a. a -> [a] -> [a]
: [(a, Text)] -> [(a, [Text])]
commentBlocks' [(a, Text)]
ls''

-- | Read test specifications from the given path, which can be a file
-- or directory containing @.fut@ files and further directories.
testSpecsFromPath :: FilePath -> IO (Either String [(FilePath, ProgramTest)])
testSpecsFromPath :: String -> IO (Either String [(String, ProgramTest)])
testSpecsFromPath String
path = do
  Either String [String]
programs_or_err <- ([String] -> Either String [String]
forall a b. b -> Either a b
Right ([String] -> Either String [String])
-> IO [String] -> IO (Either String [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
testPrograms String
path) IO (Either String [String])
-> (IOError -> IO (Either String [String]))
-> IO (Either String [String])
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO (Either String [String])
forall a. IOError -> IO (Either String a)
couldNotRead
  case Either String [String]
programs_or_err of
    Left String
err -> Either String [(String, ProgramTest)]
-> IO (Either String [(String, ProgramTest)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [(String, ProgramTest)]
 -> IO (Either String [(String, ProgramTest)]))
-> Either String [(String, ProgramTest)]
-> IO (Either String [(String, ProgramTest)])
forall a b. (a -> b) -> a -> b
$ String -> Either String [(String, ProgramTest)]
forall a b. a -> Either a b
Left String
err
    Right [String]
programs -> do
      [Either String ProgramTest]
specs_or_errs <- (String -> IO (Either String ProgramTest))
-> [String] -> IO [Either String ProgramTest]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Either String ProgramTest)
testSpecFromFile [String]
programs
      Either String [(String, ProgramTest)]
-> IO (Either String [(String, ProgramTest)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [(String, ProgramTest)]
 -> IO (Either String [(String, ProgramTest)]))
-> Either String [(String, ProgramTest)]
-> IO (Either String [(String, ProgramTest)])
forall a b. (a -> b) -> a -> b
$ [String] -> [ProgramTest] -> [(String, ProgramTest)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
programs ([ProgramTest] -> [(String, ProgramTest)])
-> Either String [ProgramTest]
-> Either String [(String, ProgramTest)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either String ProgramTest] -> Either String [ProgramTest]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either String ProgramTest]
specs_or_errs

-- | Read test specifications from the given paths, which can be a
-- files or directories containing @.fut@ files and further
-- directories.
testSpecsFromPaths :: [FilePath]
                   -> IO (Either String [(FilePath, ProgramTest)])
testSpecsFromPaths :: [String] -> IO (Either String [(String, ProgramTest)])
testSpecsFromPaths = ([Either String [(String, ProgramTest)]]
 -> Either String [(String, ProgramTest)])
-> IO [Either String [(String, ProgramTest)]]
-> IO (Either String [(String, ProgramTest)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([[(String, ProgramTest)]] -> [(String, ProgramTest)])
-> Either String [[(String, ProgramTest)]]
-> Either String [(String, ProgramTest)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(String, ProgramTest)]] -> [(String, ProgramTest)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Either String [[(String, ProgramTest)]]
 -> Either String [(String, ProgramTest)])
-> ([Either String [(String, ProgramTest)]]
    -> Either String [[(String, ProgramTest)]])
-> [Either String [(String, ProgramTest)]]
-> Either String [(String, ProgramTest)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String [(String, ProgramTest)]]
-> Either String [[(String, ProgramTest)]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence) (IO [Either String [(String, ProgramTest)]]
 -> IO (Either String [(String, ProgramTest)]))
-> ([String] -> IO [Either String [(String, ProgramTest)]])
-> [String]
-> IO (Either String [(String, ProgramTest)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO (Either String [(String, ProgramTest)]))
-> [String] -> IO [Either String [(String, ProgramTest)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Either String [(String, ProgramTest)])
testSpecsFromPath

-- | Like 'testSpecsFromPaths', but kills the process on errors.
testSpecsFromPathsOrDie :: [FilePath]
                        -> IO [(FilePath, ProgramTest)]
testSpecsFromPathsOrDie :: [String] -> IO [(String, ProgramTest)]
testSpecsFromPathsOrDie [String]
dirs = do
  Either String [(String, ProgramTest)]
specs_or_err <- [String] -> IO (Either String [(String, ProgramTest)])
testSpecsFromPaths [String]
dirs
  case Either String [(String, ProgramTest)]
specs_or_err of
    Left String
err -> do String -> IO ()
putStrLn String
err
                   IO [(String, ProgramTest)]
forall a. IO a
exitFailure
    Right [(String, ProgramTest)]
specs -> [(String, ProgramTest)] -> IO [(String, ProgramTest)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String, ProgramTest)]
specs

testPrograms :: FilePath -> IO [FilePath]
testPrograms :: String -> IO [String]
testPrograms String
dir = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isFut ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
directoryContents String
dir
  where isFut :: String -> Bool
isFut = (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
".fut") (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension

-- | Try to parse a several values from a byte string.  The 'String'
-- parameter is used for error messages.
valuesFromByteString :: String -> BS.ByteString -> Either String [Value]
valuesFromByteString :: String -> ByteString -> Either String [Value]
valuesFromByteString String
srcname =
  Either String [Value]
-> ([Value] -> Either String [Value])
-> Maybe [Value]
-> Either String [Value]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String [Value]
forall a b. a -> Either a b
Left (String -> Either String [Value])
-> String -> Either String [Value]
forall a b. (a -> b) -> a -> b
$ String
"Cannot parse values from '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
srcname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'") [Value] -> Either String [Value]
forall a b. b -> Either a b
Right (Maybe [Value] -> Either String [Value])
-> (ByteString -> Maybe [Value])
-> ByteString
-> Either String [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe [Value]
readValues

-- | Get the actual core Futhark values corresponding to a 'Values'
-- specification.  The 'FilePath' is the directory which file paths
-- are read relative to.
getValues :: (MonadFail m, MonadIO m) => FilePath -> Values -> m [Value]
getValues :: String -> Values -> m [Value]
getValues String
_ (Values [Value]
vs) =
  [Value] -> m [Value]
forall (m :: * -> *) a. Monad m => a -> m a
return [Value]
vs
getValues String
dir Values
v = do
  ByteString
s <- String -> Values -> m ByteString
forall (m :: * -> *). MonadIO m => String -> Values -> m ByteString
getValuesBS String
dir Values
v
  case String -> ByteString -> Either String [Value]
valuesFromByteString String
file ByteString
s of
    Left String
e   -> String -> m [Value]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Right [Value]
vs -> [Value] -> m [Value]
forall (m :: * -> *) a. Monad m => a -> m a
return [Value]
vs
  where file :: String
file = case Values
v of Values{} -> String
"<values>"
                         InFile String
f -> String
f
                         GenValues{} -> String
"<randomly generated>"

-- | Extract a pretty representation of some 'Values'.  In the IO
-- monad because this might involve reading from a file.  There is no
-- guarantee that the resulting byte string yields a readable value.
getValuesBS :: MonadIO m => FilePath -> Values -> m BS.ByteString
getValuesBS :: String -> Values -> m ByteString
getValuesBS String
_ (Values [Value]
vs) =
  ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Value -> Text) -> [Value] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Text
forall a. Pretty a => a -> Text
prettyText [Value]
vs
getValuesBS String
dir (InFile String
file) =
  case ShowS
takeExtension String
file of
   String
".gz" -> IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
     Either DecompressError ByteString
s <- IO ByteString -> IO (Either DecompressError ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
E.try IO ByteString
readAndDecompress
     case Either DecompressError ByteString
s of
       Left DecompressError
e   -> String -> IO ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DecompressError -> String
forall a. Show a => a -> String
show (DecompressError
e :: DecompressError)
       Right ByteString
s' -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s'

   String
_  -> IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
file'
  where file' :: String
file' = String
dir String -> ShowS
</> String
file
        readAndDecompress :: IO ByteString
readAndDecompress = do ByteString
s <- String -> IO ByteString
BS.readFile String
file'
                               ByteString -> IO ByteString
forall a. a -> IO a
E.evaluate (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
decompress ByteString
s
getValuesBS String
dir (GenValues [GenValue]
gens) =
  [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString) -> m [ByteString] -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenValue -> m ByteString) -> [GenValue] -> m [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> GenValue -> m ByteString
forall (m :: * -> *).
MonadIO m =>
String -> GenValue -> m ByteString
getGenBS String
dir) [GenValue]
gens

-- | There is a risk of race conditions when multiple programs have
-- identical 'GenValues'.  In such cases, multiple threads in 'futhark
-- test' might attempt to create the same file (or read from it, while
-- something else is constructing it).  This leads to a mess.  To
-- avoid this, we create a temporary file, and only when it is
-- complete do we move it into place.  It would be better if we could
-- use file locking, but that does not work on some file systems.  The
-- approach here seems robust enough for now, but certainly it could
-- be made even better.  The race condition that remains should mostly
-- result in duplicate work, not crashes or data corruption.
getGenBS :: MonadIO m => FilePath -> GenValue -> m BS.ByteString
getGenBS :: String -> GenValue -> m ByteString
getGenBS String
dir GenValue
gen = do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"data"
  Bool
exists_and_proper_size <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
    String -> IOMode -> (Handle -> IO Bool) -> IO Bool
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile (String
dir String -> ShowS
</> String
file) IOMode
ReadMode ((Integer -> Bool) -> IO Integer -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== GenValue -> Integer
genFileSize GenValue
gen) (IO Integer -> IO Bool)
-> (Handle -> IO Integer) -> Handle -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Integer
hFileSize)
    IO Bool -> (IOError -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOError
ex -> if IOError -> Bool
isDoesNotExistError IOError
ex then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                   else IOError -> IO Bool
forall a e. Exception e => e -> a
E.throw IOError
ex
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists_and_proper_size (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    ByteString
s <- [GenValue] -> IO ByteString
genValues [GenValue
gen]
    String -> String -> (String -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> String -> (String -> Handle -> m a) -> m a
withTempFile (String
dir String -> ShowS
</> String
"data") (GenValue -> String
genFileName GenValue
gen) ((String -> Handle -> IO ()) -> IO ())
-> (String -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmpfile Handle
h -> do
      Handle -> IO ()
hClose Handle
h -- We will be writing and reading this ourselves.
      String -> ByteString -> IO ()
SBS.writeFile String
tmpfile ByteString
s
      String -> String -> IO ()
renameFile String
tmpfile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
file
  String -> Values -> m ByteString
forall (m :: * -> *). MonadIO m => String -> Values -> m ByteString
getValuesBS String
dir (Values -> m ByteString) -> Values -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> Values
InFile String
file
  where file :: String
file = String
"data" String -> ShowS
</> GenValue -> String
genFileName GenValue
gen

genValues :: [GenValue] -> IO SBS.ByteString
genValues :: [GenValue] -> IO ByteString
genValues [GenValue]
gens = do
  (ExitCode
code, ByteString
stdout, ByteString
stderr) <- String
-> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode String
"futhark" (String
"dataset"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
args) ByteString
forall a. Monoid a => a
mempty
  case ExitCode
code of
    ExitCode
ExitSuccess ->
      ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
stdout
    ExitFailure Int
e ->
      String -> IO ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String
"'futhark dataset' failed with exit code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and stderr:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
      (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (ByteString -> [Word8]
SBS.unpack ByteString
stderr)
  where args :: [String]
args = String
"-b" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (GenValue -> [String]) -> [GenValue] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenValue -> [String]
argForGen [GenValue]
gens
        argForGen :: GenValue -> [String]
argForGen GenValue
g = [String
"-g", GenValue -> String
genValueType GenValue
g]

genFileName :: GenValue -> FilePath
genFileName :: GenValue -> String
genFileName GenValue
gen = GenValue -> String
genValueType GenValue
gen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".in"

-- | Compute the expected size of the file.  We use this to check
-- whether an existing file is broken/truncated.
genFileSize :: GenValue -> Integer
genFileSize :: GenValue -> Integer
genFileSize = GenValue -> Integer
genSize
  where header_size :: Integer
header_size = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
4 -- 'b' <version> <num_dims> <type>

        genSize :: GenValue -> Integer
genSize (GenValue [Int]
ds PrimType
t) = Integer
header_size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ds) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+
                                  [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ((Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a. Integral a => a -> Integer
toInteger [Int]
ds) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* PrimType -> Integer
forall p. Num p => PrimType -> p
primSize PrimType
t
        genSize (GenPrim PrimValue
v) =
          Integer
header_size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ PrimType -> Integer
forall p. Num p => PrimType -> p
primByteSize (PrimValue -> PrimType
primValueType PrimValue
v)

        primSize :: PrimType -> p
primSize (Signed IntType
it) = IntType -> p
forall a. Num a => IntType -> a
intByteSize IntType
it
        primSize (Unsigned IntType
it) = IntType -> p
forall a. Num a => IntType -> a
intByteSize IntType
it
        primSize (FloatType FloatType
ft) = FloatType -> p
forall a. Num a => FloatType -> a
floatByteSize FloatType
ft
        primSize PrimType
Bool = p
1

-- | When/if generating a reference output file for this run, what
-- should it be called?  Includes the "data/" folder.
testRunReferenceOutput :: FilePath -> T.Text -> TestRun -> FilePath
testRunReferenceOutput :: String -> Text -> TestRun -> String
testRunReferenceOutput String
prog Text
entry TestRun
tr =
  String
"data"
  String -> ShowS
</> ShowS
takeBaseName String
prog
  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
entry
  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
clean (TestRun -> String
runDescription TestRun
tr)
  String -> ShowS
<.> String
"out"
  where clean :: Char -> Char
clean Char
'/' = Char
'_' -- Would this ever happen?
        clean Char
' ' = Char
'_'
        clean Char
c = Char
c

-- | Get the values corresponding to an expected result, if any.
getExpectedResult :: (MonadFail m, MonadIO m) =>
                     FilePath -> T.Text -> TestRun
                  -> m (ExpectedResult [Value])
getExpectedResult :: String -> Text -> TestRun -> m (ExpectedResult [Value])
getExpectedResult String
prog Text
entry TestRun
tr =
  case TestRun -> ExpectedResult Success
runExpectedResult TestRun
tr of
    (Succeeds (Just (SuccessValues Values
vals))) ->
      Maybe [Value] -> ExpectedResult [Value]
forall values. Maybe values -> ExpectedResult values
Succeeds (Maybe [Value] -> ExpectedResult [Value])
-> ([Value] -> Maybe [Value]) -> [Value] -> ExpectedResult [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ([Value] -> ExpectedResult [Value])
-> m [Value] -> m (ExpectedResult [Value])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Values -> m [Value]
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
String -> Values -> m [Value]
getValues (ShowS
takeDirectory String
prog) Values
vals
    Succeeds (Just Success
SuccessGenerateValues) ->
      String -> Text -> TestRun -> m (ExpectedResult [Value])
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
String -> Text -> TestRun -> m (ExpectedResult [Value])
getExpectedResult String
prog Text
entry
      TestRun
tr { runExpectedResult :: ExpectedResult Success
runExpectedResult = Maybe Success -> ExpectedResult Success
forall values. Maybe values -> ExpectedResult values
Succeeds (Maybe Success -> ExpectedResult Success)
-> Maybe Success -> ExpectedResult Success
forall a b. (a -> b) -> a -> b
$ Success -> Maybe Success
forall a. a -> Maybe a
Just (Success -> Maybe Success) -> Success -> Maybe Success
forall a b. (a -> b) -> a -> b
$ Values -> Success
SuccessValues (Values -> Success) -> Values -> Success
forall a b. (a -> b) -> a -> b
$ String -> Values
InFile (String -> Values) -> String -> Values
forall a b. (a -> b) -> a -> b
$
                               String -> Text -> TestRun -> String
testRunReferenceOutput String
prog Text
entry TestRun
tr }
    Succeeds Maybe Success
Nothing ->
      ExpectedResult [Value] -> m (ExpectedResult [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpectedResult [Value] -> m (ExpectedResult [Value]))
-> ExpectedResult [Value] -> m (ExpectedResult [Value])
forall a b. (a -> b) -> a -> b
$ Maybe [Value] -> ExpectedResult [Value]
forall values. Maybe values -> ExpectedResult values
Succeeds Maybe [Value]
forall a. Maybe a
Nothing
    RunTimeFailure ExpectedError
err ->
      ExpectedResult [Value] -> m (ExpectedResult [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpectedResult [Value] -> m (ExpectedResult [Value]))
-> ExpectedResult [Value] -> m (ExpectedResult [Value])
forall a b. (a -> b) -> a -> b
$ ExpectedError -> ExpectedResult [Value]
forall values. ExpectedError -> ExpectedResult values
RunTimeFailure ExpectedError
err


-- | The name we use for compiled programs.
binaryName :: FilePath -> FilePath
binaryName :: ShowS
binaryName = ShowS
dropExtension

-- | @compileProgram extra_options futhark backend program@ compiles
-- @program@ with the command @futhark backend extra-options...@, and
-- returns stdout and stderr of the compiler.  Throws an IO exception
-- containing stderr if compilation fails.
compileProgram :: (MonadIO m, MonadError [T.Text] m) =>
                  [String] -> FilePath -> String -> FilePath
               -> m (SBS.ByteString, SBS.ByteString)
compileProgram :: [String]
-> String -> String -> String -> m (ByteString, ByteString)
compileProgram [String]
extra_options String
futhark String
backend String
program = do
  (ExitCode
futcode, ByteString
stdout, ByteString
stderr) <- IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, ByteString, ByteString)
 -> m (ExitCode, ByteString, ByteString))
-> IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ String
-> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode String
futhark (String
backendString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
options) ByteString
""
  case ExitCode
futcode of
    ExitFailure Int
127 -> [Text] -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
progNotFound (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
futhark]
    ExitFailure Int
_   -> [Text] -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [ByteString -> Text
T.decodeUtf8 ByteString
stderr]
    ExitCode
ExitSuccess     -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  (ByteString, ByteString) -> m (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
stdout, ByteString
stderr)
  where binOutputf :: String
binOutputf = ShowS
binaryName String
program
        options :: [String]
options = [String
program, String
"-o", String
binOutputf] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extra_options
        progNotFound :: a -> a
progNotFound a
s = a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
": command not found"

-- | @runProgram runner extra_options prog entry input@ runs the
-- Futhark program @prog@ (which must have the @.fut@ suffix),
-- executing the @entry@ entry point and providing @input@ on stdin.
-- The program must have been compiled in advance with
-- 'compileProgram'.  If @runner@ is non-null, then it is used as
-- "interpreter" for the compiled program (e.g. @python@ when using
-- the Python backends).  The @extra_options@ are passed to the
-- program.
runProgram :: MonadIO m =>
              String -> [String]
           -> String -> T.Text -> Values
           -> m (ExitCode, SBS.ByteString, SBS.ByteString)
runProgram :: String
-> [String]
-> String
-> Text
-> Values
-> m (ExitCode, ByteString, ByteString)
runProgram String
runner [String]
extra_options String
prog Text
entry Values
input = do
  let progbin :: String
progbin = ShowS
binaryName String
prog
      dir :: String
dir = ShowS
takeDirectory String
prog
      binpath :: String
binpath = String
"." String -> ShowS
</> String
progbin
      entry_options :: [String]
entry_options = [String
"-e", Text -> String
T.unpack Text
entry]

      (String
to_run, [String]
to_run_args)
        | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
runner = (String
binpath, [String]
entry_options [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extra_options)
        | Bool
otherwise = (String
runner, String
binpath String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
entry_options [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extra_options)

  ByteString
input' <- String -> Values -> m ByteString
forall (m :: * -> *). MonadIO m => String -> Values -> m ByteString
getValuesBS String
dir Values
input
  IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, ByteString, ByteString)
 -> m (ExitCode, ByteString, ByteString))
-> IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ String
-> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode String
to_run [String]
to_run_args (ByteString -> IO (ExitCode, ByteString, ByteString))
-> ByteString -> IO (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.toStrict ByteString
input'

-- | Ensure that any reference output files exist, or create them (by
-- compiling the program with the reference compiler and running it on
-- the input) if necessary.
ensureReferenceOutput :: (MonadIO m, MonadError [T.Text] m) =>
                         Maybe Int -> FilePath -> String -> FilePath -> [InputOutputs]
                      -> m ()
ensureReferenceOutput :: Maybe Int -> String -> String -> String -> [InputOutputs] -> m ()
ensureReferenceOutput Maybe Int
concurrency String
futhark String
compiler String
prog [InputOutputs]
ios = do
  [(Text, TestRun)]
missing <- ((Text, TestRun) -> m Bool)
-> [(Text, TestRun)] -> m [(Text, TestRun)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Text, TestRun) -> m Bool
forall (m :: * -> *). MonadIO m => (Text, TestRun) -> m Bool
isReferenceMissing ([(Text, TestRun)] -> m [(Text, TestRun)])
-> [(Text, TestRun)] -> m [(Text, TestRun)]
forall a b. (a -> b) -> a -> b
$ (InputOutputs -> [(Text, TestRun)])
-> [InputOutputs] -> [(Text, TestRun)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InputOutputs -> [(Text, TestRun)]
entryAndRuns [InputOutputs]
ios

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Text, TestRun)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, TestRun)]
missing) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    m (ByteString, ByteString) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (ByteString, ByteString) -> m ())
-> m (ByteString, ByteString) -> m ()
forall a b. (a -> b) -> a -> b
$ [String]
-> String -> String -> String -> m (ByteString, ByteString)
forall (m :: * -> *).
(MonadIO m, MonadError [Text] m) =>
[String]
-> String -> String -> String -> m (ByteString, ByteString)
compileProgram [] String
futhark String
compiler String
prog

    [Either [Text] ()]
res <- IO [Either [Text] ()] -> m [Either [Text] ()]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Either [Text] ()] -> m [Either [Text] ()])
-> IO [Either [Text] ()] -> m [Either [Text] ()]
forall a b. (a -> b) -> a -> b
$ (((Text, TestRun) -> IO (Either [Text] ()))
 -> [(Text, TestRun)] -> IO [Either [Text] ()])
-> [(Text, TestRun)]
-> ((Text, TestRun) -> IO (Either [Text] ()))
-> IO [Either [Text] ()]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe Int
-> ((Text, TestRun) -> IO (Either [Text] ()))
-> [(Text, TestRun)]
-> IO [Either [Text] ()]
forall a b. Maybe Int -> (a -> IO b) -> [a] -> IO [b]
pmapIO Maybe Int
concurrency) [(Text, TestRun)]
missing (((Text, TestRun) -> IO (Either [Text] ()))
 -> IO [Either [Text] ()])
-> ((Text, TestRun) -> IO (Either [Text] ()))
-> IO [Either [Text] ()]
forall a b. (a -> b) -> a -> b
$ \(Text
entry, TestRun
tr) -> do
      (ExitCode
code, ByteString
stdout, ByteString
stderr) <- String
-> [String]
-> String
-> Text
-> Values
-> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *).
MonadIO m =>
String
-> [String]
-> String
-> Text
-> Values
-> m (ExitCode, ByteString, ByteString)
runProgram String
"" [String
"-b"] String
prog Text
entry (Values -> IO (ExitCode, ByteString, ByteString))
-> Values -> IO (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ TestRun -> Values
runInput TestRun
tr
      case ExitCode
code of
        ExitFailure Int
e ->
          Either [Text] () -> IO (Either [Text] ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] () -> IO (Either [Text] ()))
-> Either [Text] () -> IO (Either [Text] ())
forall a b. (a -> b) -> a -> b
$ [Text] -> Either [Text] ()
forall a b. a -> Either a b
Left
          [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Reference dataset generation failed with exit code " String -> ShowS
forall a. [a] -> [a] -> [a]
++
           Int -> String
forall a. Show a => a -> String
show Int
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and stderr:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
           (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (ByteString -> [Word8]
SBS.unpack ByteString
stderr)]
        ExitCode
ExitSuccess -> do
          let f :: String
f = (Text, TestRun) -> String
file (Text
entry, TestRun
tr)
          IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
f
          String -> ByteString -> IO ()
SBS.writeFile String
f ByteString
stdout
          Either [Text] () -> IO (Either [Text] ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] () -> IO (Either [Text] ()))
-> Either [Text] () -> IO (Either [Text] ())
forall a b. (a -> b) -> a -> b
$ () -> Either [Text] ()
forall a b. b -> Either a b
Right ()

    case [Either [Text] ()] -> Either [Text] ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Either [Text] ()]
res of
      Left [Text]
err -> [Text] -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Text]
err
      Right () -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  where file :: (Text, TestRun) -> String
file (Text
entry, TestRun
tr) =
          ShowS
takeDirectory String
prog String -> ShowS
</> String -> Text -> TestRun -> String
testRunReferenceOutput String
prog Text
entry TestRun
tr

        entryAndRuns :: InputOutputs -> [(Text, TestRun)]
entryAndRuns (InputOutputs Text
entry [TestRun]
rts) = (TestRun -> (Text, TestRun)) -> [TestRun] -> [(Text, TestRun)]
forall a b. (a -> b) -> [a] -> [b]
map (Text
entry,) [TestRun]
rts

        isReferenceMissing :: (Text, TestRun) -> m Bool
isReferenceMissing (Text
entry, TestRun
tr)
          | Succeeds (Just Success
SuccessGenerateValues) <- TestRun -> ExpectedResult Success
runExpectedResult TestRun
tr =
              IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool)
-> ((Text, TestRun) -> IO Bool) -> (Text, TestRun) -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (IO Bool -> IO Bool)
-> ((Text, TestRun) -> IO Bool) -> (Text, TestRun) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist (String -> IO Bool)
-> ((Text, TestRun) -> String) -> (Text, TestRun) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, TestRun) -> String
file ((Text, TestRun) -> m Bool) -> (Text, TestRun) -> m Bool
forall a b. (a -> b) -> a -> b
$ (Text
entry, TestRun
tr)
          | Bool
otherwise =
              Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Determine the --tuning options to pass to the program.  The first
-- argument is the extension of the tuning file, or 'Nothing' if none
-- should be used.
determineTuning :: MonadIO m => Maybe FilePath -> FilePath -> m ([String], String)
determineTuning :: Maybe String -> String -> m ([String], String)
determineTuning Maybe String
Nothing String
_ = ([String], String) -> m ([String], String)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], String
forall a. Monoid a => a
mempty)
determineTuning (Just String
ext) String
program = do
  Bool
exists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist (String
program String -> ShowS
<.> String
ext)
  if Bool
exists
    then ([String], String) -> m ([String], String)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String
"--tuning", String
program String -> ShowS
<.> String
ext],
                 String
" (using " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
takeFileName (String
program String -> ShowS
<.> String
ext) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")
    else ([String], String) -> m ([String], String)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], String
forall a. Monoid a => a
mempty)