module Futhark.CLI.Misc
( mainImports,
mainHash,
mainDataget,
mainCheckSyntax,
mainThanks,
mainTokens,
)
where
import Control.Monad.State
import Data.ByteString.Lazy qualified as BS
import Data.Function (on)
import Data.List (isInfixOf, nubBy)
import Data.Loc (L (..), startPos)
import Data.Text.IO qualified as T
import Futhark.Compiler
import Futhark.Test
import Futhark.Util (hashText, interactWithFileSafely)
import Futhark.Util.Options
import Futhark.Util.Pretty (prettyTextOneLine)
import Language.Futhark.Parser.Lexer (scanTokens)
import Language.Futhark.Prop (isBuiltin)
import System.Environment (getExecutablePath)
import System.Exit
import System.FilePath
import System.IO
import System.Random
mainImports :: String -> [String] -> IO ()
mainImports :: String -> [String] -> IO ()
mainImports = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"program" forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
case [String]
args of
[String
file] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
(Warnings
_, Imports
prog_imports, VNameSource
_) <- forall (m :: * -> *).
MonadIO m =>
String -> m (Warnings, Imports, VNameSource)
readProgramOrDie String
file
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
++ String
".fut") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isBuiltin) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst Imports
prog_imports
[String]
_ -> forall a. Maybe a
Nothing
mainHash :: String -> [String] -> IO ()
mainHash :: String -> [String] -> IO ()
mainHash = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"program" forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
case [String]
args of
[String
file] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
[(String, UncheckedProg)]
prog <- forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isBuiltin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
String -> m [(String, UncheckedProg)]
readUntypedProgramOrDie String
file
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text -> Text
hashText forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Text
prettyTextOneLine forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(String, UncheckedProg)]
prog
[String]
_ -> forall a. Maybe a
Nothing
mainDataget :: String -> [String] -> IO ()
mainDataget :: String -> [String] -> IO ()
mainDataget = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"program dataset" forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
case [String]
args of
[String
file, String
dataset] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
dataget String
file String
dataset
[String]
_ -> forall a. Maybe a
Nothing
where
dataget :: String -> String -> IO ()
dataget String
prog String
dataset = do
let dir :: String
dir = String -> String
takeDirectory String
prog
[TestRun]
runs <- ProgramTest -> [TestRun]
testSpecRuns forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ProgramTest
testSpecFromProgramOrDie String
prog
let exact :: [TestRun]
exact = forall a. (a -> Bool) -> [a] -> [a]
filter ((String
dataset ==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> String
runDescription) [TestRun]
runs
infixes :: [TestRun]
infixes = forall a. (a -> Bool) -> [a] -> [a]
filter ((String
dataset `isInfixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> String
runDescription) [TestRun]
runs
FutharkExe
futhark <- String -> FutharkExe
FutharkExe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getExecutablePath
case forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TestRun -> String
runDescription) forall a b. (a -> b) -> a -> b
$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestRun]
exact then [TestRun]
infixes else [TestRun]
exact of
[TestRun
x] -> ByteString -> IO ()
BS.putStr forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FutharkExe -> String -> Values -> m ByteString
getValuesBS FutharkExe
futhark String
dir (TestRun -> Values
runInput TestRun
x)
[] -> do
Handle -> String -> IO ()
hPutStr Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"No dataset '" forall a. [a] -> [a] -> [a]
++ String
dataset forall a. [a] -> [a] -> [a]
++ String
"'.\n"
Handle -> String -> IO ()
hPutStr Handle
stderr String
"Available datasets:\n"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" " ++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> String
runDescription) [TestRun]
runs
forall a. IO a
exitFailure
[TestRun]
runs' -> do
Handle -> String -> IO ()
hPutStr Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Dataset '" forall a. [a] -> [a] -> [a]
++ String
dataset forall a. [a] -> [a] -> [a]
++ String
"' ambiguous:\n"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" " ++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> String
runDescription) [TestRun]
runs'
forall a. IO a
exitFailure
testSpecRuns :: ProgramTest -> [TestRun]
testSpecRuns = TestAction -> [TestRun]
testActionRuns forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramTest -> TestAction
testAction
testActionRuns :: TestAction -> [TestRun]
testActionRuns CompileTimeFailure {} = []
testActionRuns (RunCases [InputOutputs]
ios [StructureTest]
_ [WarningTest]
_) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InputOutputs -> [TestRun]
iosTestRuns [InputOutputs]
ios
mainCheckSyntax :: String -> [String] -> IO ()
mainCheckSyntax :: String -> [String] -> IO ()
mainCheckSyntax = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"program" forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
case [String]
args of
[String
file] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
String -> m [(String, UncheckedProg)]
readUntypedProgramOrDie String
file
[String]
_ -> forall a. Maybe a
Nothing
mainThanks :: String -> [String] -> IO ()
mainThanks :: String -> [String] -> IO ()
mainThanks = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"" forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
case [String]
args of
[] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
Int
i <- forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, Int
n forall a. Num a => a -> a -> a
- Int
1)
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [String]
responses forall a. [a] -> Int -> a
!! Int
i
[String]
_ -> forall a. Maybe a
Nothing
where
n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
responses
responses :: [String]
responses =
[ String
"You're welcome!",
String
"Tell all your friends about Futhark!",
String
"Likewise!",
String
"And thank you in return for trying the language!"
]
mainTokens :: String -> [String] -> IO ()
mainTokens :: String -> [String] -> IO ()
mainTokens = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"program" forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
case [String]
args of
[String
file] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
Maybe (Either String (Either LexerError ([L Token], Pos)))
res <- forall a. IO a -> IO (Maybe (Either String a))
interactWithFileSafely (Pos -> ByteString -> Either LexerError ([L Token], Pos)
scanTokens (String -> Pos
startPos String
file) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
file)
case Maybe (Either String (Either LexerError ([L Token], Pos)))
res of
Maybe (Either String (Either LexerError ([L Token], Pos)))
Nothing -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
file forall a. Semigroup a => a -> a -> a
<> String
": file not found."
forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2
Just (Left String
e) -> do
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr String
e
forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2
Just (Right (Left LexerError
e)) -> do
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr LexerError
e
forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2
Just (Right (Right ([L Token]
tokens, Pos
_))) ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a}. Show a => L a -> IO ()
printToken [L Token]
tokens
[String]
_ -> forall a. Maybe a
Nothing
where
printToken :: L a -> IO ()
printToken (L Loc
_ a
token) =
forall a. Show a => a -> IO ()
print a
token