module Futhark.Test
( module Futhark.Test.Spec,
valuesFromByteString,
FutharkExe (..),
getValues,
getValuesBS,
valuesAsVars,
V.compareValues,
checkResult,
testRunReferenceOutput,
getExpectedResult,
compileProgram,
runProgram,
readResults,
ensureReferenceOutput,
determineTuning,
determineCache,
binaryName,
futharkServerCfg,
V.Mismatch,
V.Value,
V.valueText,
)
where
import Codec.Compression.GZip
import Codec.Compression.Zlib.Internal (DecompressError)
import Control.Applicative
import Control.Exception (catch)
import Control.Exception.Base qualified as E
import Control.Monad
import Control.Monad.Except
import Data.Binary qualified as Bin
import Data.ByteString qualified as SBS
import Data.ByteString.Lazy qualified as BS
import Data.Char
import Data.Maybe
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.IO qualified as T
import Futhark.Script qualified as Script
import Futhark.Server
import Futhark.Server.Values
import Futhark.Test.Spec
import Futhark.Test.Values qualified as V
import Futhark.Util (isEnvVarAtLeast, pmapIO)
import Futhark.Util.Pretty (prettyText, prettyTextOneLine)
import System.Directory
import System.Exit
import System.FilePath
import System.IO (IOMode (..), hClose, hFileSize, withFile)
import System.IO.Error
import System.IO.Temp
import System.Process.ByteString (readProcessWithExitCode)
import Prelude
valuesFromByteString :: String -> BS.ByteString -> Either String [V.Value]
valuesFromByteString :: FilePath -> ByteString -> Either FilePath [Value]
valuesFromByteString FilePath
srcname =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot parse values from '" forall a. [a] -> [a] -> [a]
++ FilePath
srcname forall a. [a] -> [a] -> [a]
++ FilePath
"'") forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe [Value]
V.readValues
newtype FutharkExe = FutharkExe FilePath
deriving (FutharkExe -> FutharkExe -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FutharkExe -> FutharkExe -> Bool
$c/= :: FutharkExe -> FutharkExe -> Bool
== :: FutharkExe -> FutharkExe -> Bool
$c== :: FutharkExe -> FutharkExe -> Bool
Eq, Eq FutharkExe
FutharkExe -> FutharkExe -> Bool
FutharkExe -> FutharkExe -> Ordering
FutharkExe -> FutharkExe -> FutharkExe
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FutharkExe -> FutharkExe -> FutharkExe
$cmin :: FutharkExe -> FutharkExe -> FutharkExe
max :: FutharkExe -> FutharkExe -> FutharkExe
$cmax :: FutharkExe -> FutharkExe -> FutharkExe
>= :: FutharkExe -> FutharkExe -> Bool
$c>= :: FutharkExe -> FutharkExe -> Bool
> :: FutharkExe -> FutharkExe -> Bool
$c> :: FutharkExe -> FutharkExe -> Bool
<= :: FutharkExe -> FutharkExe -> Bool
$c<= :: FutharkExe -> FutharkExe -> Bool
< :: FutharkExe -> FutharkExe -> Bool
$c< :: FutharkExe -> FutharkExe -> Bool
compare :: FutharkExe -> FutharkExe -> Ordering
$ccompare :: FutharkExe -> FutharkExe -> Ordering
Ord, Int -> FutharkExe -> FilePath -> FilePath
[FutharkExe] -> FilePath -> FilePath
FutharkExe -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [FutharkExe] -> FilePath -> FilePath
$cshowList :: [FutharkExe] -> FilePath -> FilePath
show :: FutharkExe -> FilePath
$cshow :: FutharkExe -> FilePath
showsPrec :: Int -> FutharkExe -> FilePath -> FilePath
$cshowsPrec :: Int -> FutharkExe -> FilePath -> FilePath
Show)
getValues :: (MonadFail m, MonadIO m) => FutharkExe -> FilePath -> Values -> m [V.Value]
getValues :: forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FutharkExe -> FilePath -> Values -> m [Value]
getValues FutharkExe
_ FilePath
_ (Values [Value]
vs) = forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
vs
getValues FutharkExe
futhark FilePath
dir Values
v = do
ByteString
s <- forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FutharkExe -> FilePath -> Values -> m ByteString
getValuesBS FutharkExe
futhark FilePath
dir Values
v
case FilePath -> ByteString -> Either FilePath [Value]
valuesFromByteString (Values -> FilePath
fileName Values
v) ByteString
s of
Left FilePath
e -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
e
Right [Value]
vs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
vs
where
fileName :: Values -> FilePath
fileName Values {} = FilePath
"<values>"
fileName GenValues {} = FilePath
"<randomly generated>"
fileName ScriptValues {} = FilePath
"<FutharkScript expression>"
fileName (InFile FilePath
f) = FilePath
f
fileName (ScriptFile FilePath
f) = FilePath
f
readAndDecompress :: FilePath -> IO (Either DecompressError BS.ByteString)
readAndDecompress :: FilePath -> IO (Either DecompressError ByteString)
readAndDecompress FilePath
file = forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ do
ByteString
s <- FilePath -> IO ByteString
BS.readFile FilePath
file
forall a. a -> IO a
E.evaluate forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
decompress ByteString
s
getValuesBS :: (MonadFail m, MonadIO m) => FutharkExe -> FilePath -> Values -> m BS.ByteString
getValuesBS :: forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FutharkExe -> FilePath -> Values -> m ByteString
getValuesBS FutharkExe
_ FilePath
_ (Values [Value]
vs) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Value -> Text
V.valueText [Value]
vs
getValuesBS FutharkExe
_ FilePath
dir (InFile FilePath
file) =
case FilePath -> FilePath
takeExtension FilePath
file of
FilePath
".gz" -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Either DecompressError ByteString
s <- FilePath -> IO (Either DecompressError ByteString)
readAndDecompress FilePath
file'
case Either DecompressError ByteString
s of
Left DecompressError
e -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show DecompressError
e
Right ByteString
s' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
s'
FilePath
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile FilePath
file'
where
file' :: FilePath
file' = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file
getValuesBS FutharkExe
futhark FilePath
dir (GenValues [GenValue]
gens) =
forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
FutharkExe -> FilePath -> GenValue -> m ByteString
getGenBS FutharkExe
futhark FilePath
dir) [GenValue]
gens
getValuesBS FutharkExe
_ FilePath
_ (ScriptValues Exp
e) =
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$
FilePath
"Cannot get values from FutharkScript expression: "
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (forall a. Pretty a => a -> Text
prettyTextOneLine Exp
e)
getValuesBS FutharkExe
_ FilePath
_ (ScriptFile FilePath
f) =
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot get values from FutharkScript file: " forall a. Semigroup a => a -> a -> a
<> FilePath
f
valueAsVar ::
(MonadError T.Text m, MonadIO m) =>
Server ->
VarName ->
V.Value ->
m ()
valueAsVar :: forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Server -> Text -> Value -> m ()
valueAsVar Server
server Text
v Value
val =
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe forall a b. (a -> b) -> a -> b
$ Server -> Text -> Value -> IO (Maybe CmdFailure)
putValue Server
server Text
v Value
val
scriptValueAsVars ::
(MonadError T.Text m, MonadIO m) =>
Server ->
[(VarName, TypeName)] ->
Script.ExpValue ->
m ()
scriptValueAsVars :: forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Server -> [(Text, Text)] -> ExpValue -> m ()
scriptValueAsVars Server
server [(Text, Text)]
names_and_types ExpValue
val
| [ExpValue]
vals <- forall v. Compound v -> [Compound v]
V.unCompound ExpValue
val,
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text)]
names_and_types forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExpValue]
vals,
Just [m ()]
loads <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM forall {m :: * -> *}.
(MonadError Text m, MonadIO m) =>
(Text, Text) -> ExpValue -> Maybe (m ())
f [(Text, Text)]
names_and_types [ExpValue]
vals =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [m ()]
loads
where
f :: (Text, Text) -> ExpValue -> Maybe (m ())
f (Text
v, Text
t0) (V.ValueAtom (Script.SValue Text
t1 ValOrVar
sval))
| Text
t0 forall a. Eq a => a -> a -> Bool
== Text
t1 =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case ValOrVar
sval of
Script.VVar Text
oldname ->
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe forall a b. (a -> b) -> a -> b
$ Server -> Text -> Text -> IO (Maybe CmdFailure)
cmdRename Server
server Text
oldname Text
v
Script.VVal Value
sval' ->
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Server -> Text -> Value -> m ()
valueAsVar Server
server Text
v Value
sval'
f (Text, Text)
_ ExpValue
_ = forall a. Maybe a
Nothing
scriptValueAsVars Server
server [(Text, Text)]
names_and_types ExpValue
val = do
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe forall a b. (a -> b) -> a -> b
$ Server -> [Text] -> IO (Maybe CmdFailure)
cmdFree Server
server forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ ExpValue -> Set Text
Script.serverVarsInValue ExpValue
val
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
Text
"Expected value of type: "
forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
prettyTextOneLine (forall v. [Compound v] -> Compound v
V.mkCompound (forall a b. (a -> b) -> [a] -> [b]
map (forall v. v -> Compound v
V.ValueAtom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Text, Text)]
names_and_types))
forall a. Semigroup a => a -> a -> a
<> Text
"\nBut got value of type: "
forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
prettyTextOneLine (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall v. ScriptValue v -> ScriptValueType
Script.scriptValueType ExpValue
val)
forall a. Semigroup a => a -> a -> a
<> Text
notes
where
notes :: Text
notes = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (a, Text) -> Maybe Text
note [(Text, Text)]
names_and_types
note :: (a, Text) -> Maybe Text
note (a
_, Text
t)
| Text
"(" Text -> Text -> Bool
`T.isPrefixOf` Text
t =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
Text
"\nNote: expected type "
forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
prettyText Text
t
forall a. Semigroup a => a -> a -> a
<> Text
" is an opaque tuple that cannot be constructed\n"
forall a. Semigroup a => a -> a -> a
<> Text
"in FutharkScript. Consider using type annotations to give it a proper name."
| Text
"{" Text -> Text -> Bool
`T.isPrefixOf` Text
t =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
Text
"\nNote: expected type "
forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
prettyText Text
t
forall a. Semigroup a => a -> a -> a
<> Text
" is an opaque record that cannot be constructed\n"
forall a. Semigroup a => a -> a -> a
<> Text
"in FutharkScript. Consider using type annotations to give it a proper name."
| Bool
otherwise =
forall a. Maybe a
Nothing
valuesAsVars ::
(MonadError T.Text m, MonadIO m) =>
Server ->
[(VarName, TypeName)] ->
FutharkExe ->
FilePath ->
Values ->
m ()
valuesAsVars :: forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Server
-> [(Text, Text)] -> FutharkExe -> FilePath -> Values -> m ()
valuesAsVars Server
server [(Text, Text)]
names_and_types FutharkExe
_ FilePath
dir (InFile FilePath
file)
| FilePath -> FilePath
takeExtension FilePath
file forall a. Eq a => a -> a -> Bool
== FilePath
".gz" = do
Either DecompressError ByteString
s <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either DecompressError ByteString)
readAndDecompress forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file
case Either DecompressError ByteString
s of
Left DecompressError
e ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show FilePath
file forall a. Semigroup a => a -> a -> a
<> FilePath
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show DecompressError
e
Right ByteString
s' ->
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"futhark-input" forall a b. (a -> b) -> a -> b
$ \FilePath
tmpf Handle
tmpf_h -> do
Handle -> ByteString -> IO ()
BS.hPutStr Handle
tmpf_h ByteString
s'
Handle -> IO ()
hClose Handle
tmpf_h
Server -> FilePath -> [(Text, Text)] -> IO (Maybe CmdFailure)
cmdRestore Server
server FilePath
tmpf [(Text, Text)]
names_and_types
| Bool
otherwise =
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe forall a b. (a -> b) -> a -> b
$ Server -> FilePath -> [(Text, Text)] -> IO (Maybe CmdFailure)
cmdRestore Server
server (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file) [(Text, Text)]
names_and_types
valuesAsVars Server
server [(Text, Text)]
names_and_types FutharkExe
futhark FilePath
dir (GenValues [GenValue]
gens) = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenValue]
gens forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text)]
names_and_types) forall a b. (a -> b) -> a -> b
$
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"Mismatch between number of expected and generated values."
[FilePath]
gen_fs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
FutharkExe -> FilePath -> GenValue -> m FilePath
getGenFile FutharkExe
futhark FilePath
dir) [GenValue]
gens
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
gen_fs [(Text, Text)]
names_and_types) forall a b. (a -> b) -> a -> b
$ \(FilePath
file, (Text
v, Text
t)) ->
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe forall a b. (a -> b) -> a -> b
$ Server -> FilePath -> [(Text, Text)] -> IO (Maybe CmdFailure)
cmdRestore Server
server (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file) [(Text
v, Text
t)]
valuesAsVars Server
server [(Text, Text)]
names_and_types FutharkExe
_ FilePath
_ (Values [Value]
vs) = do
let types :: [Text]
types = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Text, Text)]
names_and_types
vs_types :: [Text]
vs_types = forall a b. (a -> b) -> [a] -> [b]
map (ValueType -> Text
V.valueTypeTextNoDims forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ValueType
V.valueType) [Value]
vs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text]
types forall a. Eq a => a -> a -> Bool
== [Text]
vs_types) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$
[ Text
"Expected input of types: " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Text
prettyTextOneLine [Text]
types),
Text
"Provided input of types: " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Text
prettyTextOneLine [Text]
vs_types)
]
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"futhark-input" forall a b. (a -> b) -> a -> b
$ \FilePath
tmpf Handle
tmpf_h -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> ByteString -> IO ()
BS.hPutStr Handle
tmpf_h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => a -> ByteString
Bin.encode) [Value]
vs
Handle -> IO ()
hClose Handle
tmpf_h
Server -> FilePath -> [(Text, Text)] -> IO (Maybe CmdFailure)
cmdRestore Server
server FilePath
tmpf [(Text, Text)]
names_and_types
valuesAsVars Server
server [(Text, Text)]
names_and_types FutharkExe
_ FilePath
_ (ScriptValues Exp
e) =
forall (m :: * -> *) a.
MonadIO m =>
Server -> (ScriptServer -> m a) -> m a
Script.withScriptServer' Server
server forall a b. (a -> b) -> a -> b
$ \ScriptServer
server' -> do
ExpValue
e_v <- forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
EvalBuiltin m -> ScriptServer -> Exp -> m ExpValue
Script.evalExp forall {e} {m :: * -> *} {p} {a}.
(MonadError e m, Semigroup e, IsString e) =>
e -> p -> m a
noBuiltin ScriptServer
server' Exp
e
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Server -> [(Text, Text)] -> ExpValue -> m ()
scriptValueAsVars Server
server [(Text, Text)]
names_and_types ExpValue
e_v
where
noBuiltin :: e -> p -> m a
noBuiltin e
f p
_ = do
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ e
"Unknown builtin procedure: " forall a. Semigroup a => a -> a -> a
<> e
f
valuesAsVars Server
server [(Text, Text)]
names_and_types FutharkExe
futhark FilePath
dir (ScriptFile FilePath
f) = do
Exp
e <-
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> Either Text Exp
Script.parseExpFromText FilePath
f
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
T.readFile (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
f))
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Server
-> [(Text, Text)] -> FutharkExe -> FilePath -> Values -> m ()
valuesAsVars Server
server [(Text, Text)]
names_and_types FutharkExe
futhark FilePath
dir (Exp -> Values
ScriptValues Exp
e)
getGenFile :: MonadIO m => FutharkExe -> FilePath -> GenValue -> m FilePath
getGenFile :: forall (m :: * -> *).
MonadIO m =>
FutharkExe -> FilePath -> GenValue -> m FilePath
getGenFile FutharkExe
futhark FilePath
dir GenValue
gen = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"data"
Bool
exists_and_proper_size <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file) IOMode
ReadMode (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
== GenValue -> Integer
genFileSize GenValue
gen) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Integer
hFileSize)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOError
ex ->
if IOError -> Bool
isDoesNotExistError IOError
ex
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else forall a e. Exception e => e -> a
E.throw IOError
ex
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists_and_proper_size forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
ByteString
s <- FutharkExe -> [GenValue] -> IO ByteString
genValues FutharkExe
futhark [GenValue
gen]
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
withTempFile (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"data") (GenValue -> FilePath
genFileName GenValue
gen) forall a b. (a -> b) -> a -> b
$ \FilePath
tmpfile Handle
h -> do
Handle -> IO ()
hClose Handle
h
FilePath -> ByteString -> IO ()
SBS.writeFile FilePath
tmpfile ByteString
s
FilePath -> FilePath -> IO ()
renameFile FilePath
tmpfile forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
file
where
file :: FilePath
file = FilePath
"data" FilePath -> FilePath -> FilePath
</> GenValue -> FilePath
genFileName GenValue
gen
getGenBS :: MonadIO m => FutharkExe -> FilePath -> GenValue -> m BS.ByteString
getGenBS :: forall (m :: * -> *).
MonadIO m =>
FutharkExe -> FilePath -> GenValue -> m ByteString
getGenBS FutharkExe
futhark FilePath
dir GenValue
gen = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BS.readFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
dir </>) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
MonadIO m =>
FutharkExe -> FilePath -> GenValue -> m FilePath
getGenFile FutharkExe
futhark FilePath
dir GenValue
gen
genValues :: FutharkExe -> [GenValue] -> IO SBS.ByteString
genValues :: FutharkExe -> [GenValue] -> IO ByteString
genValues (FutharkExe FilePath
futhark) [GenValue]
gens = do
(ExitCode
code, ByteString
stdout, ByteString
stderr) <- FilePath
-> [FilePath]
-> ByteString
-> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode FilePath
futhark (FilePath
"dataset" forall a. a -> [a] -> [a]
: [FilePath]
args) forall a. Monoid a => a
mempty
case ExitCode
code of
ExitCode
ExitSuccess ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
stdout
ExitFailure Int
e ->
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$
FilePath
"'futhark dataset' failed with exit code "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
e
forall a. [a] -> [a] -> [a]
++ FilePath
" and stderr:\n"
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (ByteString -> [Word8]
SBS.unpack ByteString
stderr)
where
args :: [FilePath]
args = FilePath
"-b" forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenValue -> [FilePath]
argForGen [GenValue]
gens
argForGen :: GenValue -> [FilePath]
argForGen GenValue
g = [FilePath
"-g", GenValue -> FilePath
genValueType GenValue
g]
genFileName :: GenValue -> FilePath
genFileName :: GenValue -> FilePath
genFileName GenValue
gen = GenValue -> FilePath
genValueType GenValue
gen forall a. [a] -> [a] -> [a]
++ FilePath
".in"
genFileSize :: GenValue -> Integer
genFileSize :: GenValue -> Integer
genFileSize = GenValue -> Integer
genSize
where
header_size :: Int
header_size = Int
1 forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ Int
4
genSize :: GenValue -> Integer
genSize (GenValue (V.ValueType [Int]
ds PrimType
t)) =
forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$
Int
header_size
forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ds forall a. Num a => a -> a -> a
* Int
8
forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
ds forall a. Num a => a -> a -> a
* PrimType -> Int
V.primTypeBytes PrimType
t
genSize (GenPrim Value
v) =
forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ Int
header_size forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (Value -> [Int]
V.valueShape Value
v) forall a. Num a => a -> a -> a
* PrimType -> Int
V.primTypeBytes (Value -> PrimType
V.valueElemType Value
v)
testRunReferenceOutput :: FilePath -> T.Text -> TestRun -> FilePath
testRunReferenceOutput :: FilePath -> Text -> TestRun -> FilePath
testRunReferenceOutput FilePath
prog Text
entry TestRun
tr =
FilePath
"data"
FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeBaseName FilePath
prog
forall a. Semigroup a => a -> a -> a
<> FilePath
":"
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
entry
forall a. Semigroup a => a -> a -> a
<> FilePath
"-"
forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
clean (TestRun -> FilePath
runDescription TestRun
tr)
FilePath -> FilePath -> FilePath
<.> FilePath
"out"
where
clean :: Char -> Char
clean Char
'/' = Char
'_'
clean Char
' ' = Char
'_'
clean Char
c = Char
c
getExpectedResult ::
(MonadFail m, MonadIO m) =>
FutharkExe ->
FilePath ->
T.Text ->
TestRun ->
m (ExpectedResult [V.Value])
getExpectedResult :: forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FutharkExe
-> FilePath -> Text -> TestRun -> m (ExpectedResult [Value])
getExpectedResult FutharkExe
futhark FilePath
prog Text
entry TestRun
tr =
case TestRun -> ExpectedResult Success
runExpectedResult TestRun
tr of
(Succeeds (Just (SuccessValues Values
vals))) ->
forall values. Maybe values -> ExpectedResult values
Succeeds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FutharkExe -> FilePath -> Values -> m [Value]
getValues FutharkExe
futhark (FilePath -> FilePath
takeDirectory FilePath
prog) Values
vals
Succeeds (Just Success
SuccessGenerateValues) ->
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FutharkExe
-> FilePath -> Text -> TestRun -> m (ExpectedResult [Value])
getExpectedResult FutharkExe
futhark FilePath
prog Text
entry TestRun
tr'
where
tr' :: TestRun
tr' =
TestRun
tr
{ runExpectedResult :: ExpectedResult Success
runExpectedResult =
forall values. Maybe values -> ExpectedResult values
Succeeds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> Success
SuccessValues forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Values
InFile forall a b. (a -> b) -> a -> b
$
FilePath -> Text -> TestRun -> FilePath
testRunReferenceOutput FilePath
prog Text
entry TestRun
tr
}
Succeeds Maybe Success
Nothing ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall values. Maybe values -> ExpectedResult values
Succeeds forall a. Maybe a
Nothing
RunTimeFailure ExpectedError
err ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall values. ExpectedError -> ExpectedResult values
RunTimeFailure ExpectedError
err
binaryName :: FilePath -> FilePath
binaryName :: FilePath -> FilePath
binaryName = FilePath -> FilePath
dropExtension
compileProgram ::
(MonadIO m, MonadError [T.Text] m) =>
[String] ->
FutharkExe ->
String ->
FilePath ->
m (SBS.ByteString, SBS.ByteString)
compileProgram :: forall (m :: * -> *).
(MonadIO m, MonadError [Text] m) =>
[FilePath]
-> FutharkExe -> FilePath -> FilePath -> m (ByteString, ByteString)
compileProgram [FilePath]
extra_options (FutharkExe FilePath
futhark) FilePath
backend FilePath
program = do
(ExitCode
futcode, ByteString
stdout, ByteString
stderr) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> ByteString
-> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode FilePath
futhark (FilePath
backend forall a. a -> [a] -> [a]
: [FilePath]
options) ByteString
""
case ExitCode
futcode of
ExitFailure Int
127 -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall {a}. (Semigroup a, IsString a) => a -> a
progNotFound forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
futhark]
ExitFailure Int
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [ByteString -> Text
T.decodeUtf8 ByteString
stderr]
ExitCode
ExitSuccess -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
stdout, ByteString
stderr)
where
binOutputf :: FilePath
binOutputf = FilePath -> FilePath
binaryName FilePath
program
options :: [FilePath]
options = [FilePath
program, FilePath
"-o", FilePath
binOutputf] forall a. [a] -> [a] -> [a]
++ [FilePath]
extra_options
progNotFound :: a -> a
progNotFound a
s = a
s forall a. Semigroup a => a -> a -> a
<> a
": command not found"
runProgram ::
FutharkExe ->
FilePath ->
[String] ->
String ->
T.Text ->
Values ->
IO (ExitCode, SBS.ByteString, SBS.ByteString)
runProgram :: FutharkExe
-> FilePath
-> [FilePath]
-> FilePath
-> Text
-> Values
-> IO (ExitCode, ByteString, ByteString)
runProgram FutharkExe
futhark FilePath
runner [FilePath]
extra_options FilePath
prog Text
entry Values
input = do
let progbin :: FilePath
progbin = FilePath -> FilePath
binaryName FilePath
prog
dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
prog
binpath :: FilePath
binpath = FilePath
"." FilePath -> FilePath -> FilePath
</> FilePath
progbin
entry_options :: [FilePath]
entry_options = [FilePath
"-e", Text -> FilePath
T.unpack Text
entry]
(FilePath
to_run, [FilePath]
to_run_args)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
runner = (FilePath
binpath, [FilePath]
entry_options forall a. [a] -> [a] -> [a]
++ [FilePath]
extra_options)
| Bool
otherwise = (FilePath
runner, FilePath
binpath forall a. a -> [a] -> [a]
: [FilePath]
entry_options forall a. [a] -> [a] -> [a]
++ [FilePath]
extra_options)
ByteString
input' <- forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FutharkExe -> FilePath -> Values -> m ByteString
getValuesBS FutharkExe
futhark FilePath
dir Values
input
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> ByteString
-> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode FilePath
to_run [FilePath]
to_run_args forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.toStrict ByteString
input'
readResults ::
(MonadIO m, MonadError T.Text m) =>
Server ->
[VarName] ->
m [V.Value]
readResults :: forall (m :: * -> *).
(MonadIO m, MonadError Text m) =>
Server -> [Text] -> m [Value]
readResults Server
server =
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Server -> Text -> IO (Either Text Value)
getValue Server
server)
ensureReferenceOutput ::
(MonadIO m, MonadError [T.Text] m) =>
Maybe Int ->
FutharkExe ->
String ->
FilePath ->
[InputOutputs] ->
m ()
ensureReferenceOutput :: forall (m :: * -> *).
(MonadIO m, MonadError [Text] m) =>
Maybe Int
-> FutharkExe -> FilePath -> FilePath -> [InputOutputs] -> m ()
ensureReferenceOutput Maybe Int
concurrency FutharkExe
futhark FilePath
compiler FilePath
prog [InputOutputs]
ios = do
[(Text, TestRun)]
missing <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall {m :: * -> *}. MonadIO m => (Text, TestRun) -> m Bool
isReferenceMissing forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InputOutputs -> [(Text, TestRun)]
entryAndRuns [InputOutputs]
ios
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, TestRun)]
missing) forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, MonadError [Text] m) =>
[FilePath]
-> FutharkExe -> FilePath -> FilePath -> m (ByteString, ByteString)
compileProgram [] FutharkExe
futhark FilePath
compiler FilePath
prog
[Either [Text] ()]
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. Maybe Int -> (a -> IO b) -> [a] -> IO [b]
pmapIO Maybe Int
concurrency) [(Text, TestRun)]
missing forall a b. (a -> b) -> a -> b
$ \(Text
entry, TestRun
tr) -> do
(ExitCode
code, ByteString
stdout, ByteString
stderr) <- FutharkExe
-> FilePath
-> [FilePath]
-> FilePath
-> Text
-> Values
-> IO (ExitCode, ByteString, ByteString)
runProgram FutharkExe
futhark FilePath
"" [FilePath
"-b"] FilePath
prog Text
entry forall a b. (a -> b) -> a -> b
$ TestRun -> Values
runInput TestRun
tr
case ExitCode
code of
ExitFailure Int
e ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a b. a -> Either a b
Left
[ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$
FilePath
"Reference dataset generation failed with exit code "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
e
forall a. [a] -> [a] -> [a]
++ FilePath
" and stderr:\n"
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (ByteString -> [Word8]
SBS.unpack ByteString
stderr)
]
ExitCode
ExitSuccess -> do
let f :: FilePath
f = (Text, TestRun) -> FilePath
file (Text
entry, TestRun
tr)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
f
FilePath -> ByteString -> IO ()
SBS.writeFile FilePath
f ByteString
stdout
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
case forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Either [Text] ()]
res of
Left [Text]
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Text]
err
Right () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
file :: (Text, TestRun) -> FilePath
file (Text
entry, TestRun
tr) =
FilePath -> FilePath
takeDirectory FilePath
prog FilePath -> FilePath -> FilePath
</> FilePath -> Text -> TestRun -> FilePath
testRunReferenceOutput FilePath
prog Text
entry TestRun
tr
entryAndRuns :: InputOutputs -> [(Text, TestRun)]
entryAndRuns (InputOutputs Text
entry [TestRun]
rts) = 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 =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
(forall a. Ord a => a -> a -> Bool
(<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO UTCTime
getModificationTime ((Text, TestRun) -> FilePath
file (Text
entry, TestRun
tr)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO UTCTime
getModificationTime FilePath
prog)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else forall a e. Exception e => e -> a
E.throw IOError
e)
| Bool
otherwise =
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
determineTuning :: MonadIO m => Maybe FilePath -> FilePath -> m ([String], String)
determineTuning :: forall (m :: * -> *).
MonadIO m =>
Maybe FilePath -> FilePath -> m ([FilePath], FilePath)
determineTuning Maybe FilePath
Nothing FilePath
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], forall a. Monoid a => a
mempty)
determineTuning (Just FilePath
ext) FilePath
program = do
Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath
program FilePath -> FilePath -> FilePath
<.> FilePath
ext)
if Bool
exists
then
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( [FilePath
"--tuning", FilePath
program FilePath -> FilePath -> FilePath
<.> FilePath
ext],
FilePath
" (using " forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
takeFileName (FilePath
program FilePath -> FilePath -> FilePath
<.> FilePath
ext) forall a. Semigroup a => a -> a -> a
<> FilePath
")"
)
else forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], FilePath
" (no tuning file)")
determineCache :: Maybe FilePath -> FilePath -> [String]
determineCache :: Maybe FilePath -> FilePath -> [FilePath]
determineCache Maybe FilePath
Nothing FilePath
_ = []
determineCache (Just FilePath
ext) FilePath
program = [FilePath
"--cache-file", FilePath
program FilePath -> FilePath -> FilePath
<.> FilePath
ext]
checkResult ::
(MonadError T.Text m, MonadIO m) =>
FilePath ->
[V.Value] ->
[V.Value] ->
m ()
checkResult :: forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
FilePath -> [Value] -> [Value] -> m ()
checkResult FilePath
program [Value]
expected_vs [Value]
actual_vs =
case Tolerance -> [Value] -> [Value] -> [Mismatch]
V.compareSeveralValues (Double -> Tolerance
V.Tolerance Double
0.002) [Value]
actual_vs [Value]
expected_vs of
Mismatch
mismatch : [Mismatch]
mismatches -> do
let actualf :: FilePath
actualf = FilePath
program FilePath -> FilePath -> FilePath
<.> FilePath
"actual"
expectedf :: FilePath
expectedf = FilePath
program FilePath -> FilePath -> FilePath
<.> FilePath
"expected"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
BS.writeFile FilePath
actualf forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Binary a => a -> ByteString
Bin.encode [Value]
actual_vs
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
BS.writeFile FilePath
expectedf forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Binary a => a -> ByteString
Bin.encode [Value]
expected_vs
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
FilePath -> Text
T.pack FilePath
actualf
forall a. Semigroup a => a -> a -> a
<> Text
" and "
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
expectedf
forall a. Semigroup a => a -> a -> a
<> Text
" do not match:\n"
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (forall a. Show a => a -> FilePath
show Mismatch
mismatch)
forall a. Semigroup a => a -> a -> a
<> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Mismatch]
mismatches
then forall a. Monoid a => a
mempty
else Text
"\n...and " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
prettyText (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mismatch]
mismatches) forall a. Semigroup a => a -> a -> a
<> Text
" other mismatches."
[] ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
futharkServerCfg :: FilePath -> [String] -> ServerCfg
futharkServerCfg :: FilePath -> [FilePath] -> ServerCfg
futharkServerCfg FilePath
prog [FilePath]
opts =
(FilePath -> [FilePath] -> ServerCfg
newServerCfg FilePath
prog [FilePath]
opts)
{ cfgDebug :: Bool
cfgDebug = FilePath -> Int -> Bool
isEnvVarAtLeast FilePath
"FUTHARK_COMPILER_DEBUGGING" Int
1
}