{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TupleSections #-}
module Futhark.CodeGen.Backends.GenericC.CLI
( cliDefs,
)
where
import Data.List (unzip5)
import qualified Data.Map as M
import qualified Data.Text as T
import Futhark.CodeGen.Backends.GenericC.Manifest
import Futhark.CodeGen.Backends.GenericC.Options
import Futhark.CodeGen.Backends.SimpleRep
( cproduct,
primAPIType,
primStorageType,
scalarToPrim,
)
import Futhark.CodeGen.RTS.C (tuningH, valuesH)
import Futhark.Util.Pretty (pretty, prettyText)
import qualified Language.C.Quote.OpenCL as C
import qualified Language.C.Syntax as C
genericOptions :: [Option]
genericOptions :: [Option]
genericOptions =
[ Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"write-runtime-to",
optionShortName :: Maybe Char
optionShortName = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
't',
optionArgument :: OptionArgument
optionArgument = String -> OptionArgument
RequiredArgument String
"FILE",
optionDescription :: String
optionDescription = String
"Print the time taken to execute the program to the indicated file, an integral number of microseconds.",
optionAction :: Stm
optionAction = Stm
set_runtime_file
},
Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"runs",
optionShortName :: Maybe Char
optionShortName = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'r',
optionArgument :: OptionArgument
optionArgument = String -> OptionArgument
RequiredArgument String
"INT",
optionDescription :: String
optionDescription = String
"Perform NUM runs of the program.",
optionAction :: Stm
optionAction = Stm
set_num_runs
},
Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"debugging",
optionShortName :: Maybe Char
optionShortName = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'D',
optionArgument :: OptionArgument
optionArgument = OptionArgument
NoArgument,
optionDescription :: String
optionDescription = String
"Perform possibly expensive internal correctness checks and verbose logging.",
optionAction :: Stm
optionAction = [C.cstm|futhark_context_config_set_debugging(cfg, 1);|]
},
Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"log",
optionShortName :: Maybe Char
optionShortName = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'L',
optionArgument :: OptionArgument
optionArgument = OptionArgument
NoArgument,
optionDescription :: String
optionDescription = String
"Print various low-overhead logging information to stderr while running.",
optionAction :: Stm
optionAction = [C.cstm|futhark_context_config_set_logging(cfg, 1);|]
},
Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"entry-point",
optionShortName :: Maybe Char
optionShortName = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'e',
optionArgument :: OptionArgument
optionArgument = String -> OptionArgument
RequiredArgument String
"NAME",
optionDescription :: String
optionDescription = String
"The entry point to run. Defaults to main.",
optionAction :: Stm
optionAction = [C.cstm|if (entry_point != NULL) entry_point = optarg;|]
},
Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"binary-output",
optionShortName :: Maybe Char
optionShortName = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'b',
optionArgument :: OptionArgument
optionArgument = OptionArgument
NoArgument,
optionDescription :: String
optionDescription = String
"Print the program result in the binary output format.",
optionAction :: Stm
optionAction = [C.cstm|binary_output = 1;|]
},
Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"no-print-result",
optionShortName :: Maybe Char
optionShortName = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'n',
optionArgument :: OptionArgument
optionArgument = OptionArgument
NoArgument,
optionDescription :: String
optionDescription = String
"Do not print the program result.",
optionAction :: Stm
optionAction = [C.cstm|print_result = 0;|]
},
Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"help",
optionShortName :: Maybe Char
optionShortName = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'h',
optionArgument :: OptionArgument
optionArgument = OptionArgument
NoArgument,
optionDescription :: String
optionDescription = String
"Print help information and exit.",
optionAction :: Stm
optionAction =
[C.cstm|{
printf("Usage: %s [OPTION]...\nOptions:\n\n%s\nFor more information, consult the Futhark User's Guide or the man pages.\n",
fut_progname, option_descriptions);
exit(0);
}|]
},
Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"print-params",
optionShortName :: Maybe Char
optionShortName = Maybe Char
forall a. Maybe a
Nothing,
optionArgument :: OptionArgument
optionArgument = OptionArgument
NoArgument,
optionDescription :: String
optionDescription = String
"Print all tuning parameters that can be set with --param or --tuning.",
optionAction :: Stm
optionAction =
[C.cstm|{
int n = futhark_get_tuning_param_count();
for (int i = 0; i < n; i++) {
printf("%s (%s)\n", futhark_get_tuning_param_name(i),
futhark_get_tuning_param_class(i));
}
exit(0);
}|]
},
Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"param",
optionShortName :: Maybe Char
optionShortName = Maybe Char
forall a. Maybe a
Nothing,
optionArgument :: OptionArgument
optionArgument = String -> OptionArgument
RequiredArgument String
"ASSIGNMENT",
optionDescription :: String
optionDescription = String
"Set a tuning parameter to the given value.",
optionAction :: Stm
optionAction =
[C.cstm|{
char *name = optarg;
char *equals = strstr(optarg, "=");
char *value_str = equals != NULL ? equals+1 : optarg;
int value = atoi(value_str);
if (equals != NULL) {
*equals = 0;
if (futhark_context_config_set_tuning_param(cfg, name, (size_t)value) != 0) {
futhark_panic(1, "Unknown size: %s\n", name);
}
} else {
futhark_panic(1, "Invalid argument for size option: %s\n", optarg);
}}|]
},
Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
{ optionLongName :: String
optionLongName = String
"tuning",
optionShortName :: Maybe Char
optionShortName = Maybe Char
forall a. Maybe a
Nothing,
optionArgument :: OptionArgument
optionArgument = String -> OptionArgument
RequiredArgument String
"FILE",
optionDescription :: String
optionDescription = String
"Read size=value assignments from the given file.",
optionAction :: Stm
optionAction =
[C.cstm|{
char *ret = load_tuning_file(optarg, cfg, (int(*)(void*, const char*, size_t))
futhark_context_config_set_tuning_param);
if (ret != NULL) {
futhark_panic(1, "When loading tuning from '%s': %s\n", optarg, ret);
}}|]
}
]
where
set_runtime_file :: Stm
set_runtime_file =
[C.cstm|{
runtime_file = fopen(optarg, "w");
if (runtime_file == NULL) {
futhark_panic(1, "Cannot open %s: %s\n", optarg, strerror(errno));
}
}|]
set_num_runs :: Stm
set_num_runs =
[C.cstm|{
num_runs = atoi(optarg);
perform_warmup = 1;
if (num_runs <= 0) {
futhark_panic(1, "Need a positive number of runs, not %s\n", optarg);
}
}|]
readInput :: Manifest -> Int -> T.Text -> ([C.BlockItem], C.Stm, C.Stm, C.Stm, C.Exp)
readInput :: Manifest -> Int -> Text -> ([BlockItem], Stm, Stm, Stm, Exp)
readInput Manifest
manifest Int
i Text
tname =
case Text -> Map Text Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
tname (Map Text Type -> Maybe Type) -> Map Text Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Manifest -> Map Text Type
manifestTypes Manifest
manifest of
Maybe Type
Nothing ->
let (Signedness
_, PrimType
t) = Text -> (Signedness, PrimType)
scalarToPrim Text
tname
dest :: String
dest = String
"read_value_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
info :: String
info = Text -> String
T.unpack Text
tname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_info"
in ( [C.citems|
$ty:(primStorageType t) $id:dest;
if (read_scalar(stdin, &$id:info, &$id:dest) != 0) {
futhark_panic(1, "Error when reading input #%d of type %s (errno: %s).\n",
$int:i,
$string:(T.unpack tname),
strerror(errno));
};|],
[C.cstm|;|],
[C.cstm|;|],
[C.cstm|;|],
[C.cexp|$id:dest|]
)
Just (TypeOpaque Text
desc OpaqueOps
_) ->
( [C.citems|futhark_panic(1, "Cannot read input #%d of type %s\n", $int:i, $string:(T.unpack desc));|],
[C.cstm|;|],
[C.cstm|;|],
[C.cstm|;|],
[C.cexp|NULL|]
)
Just (TypeArray Text
t Text
et Int
rank ArrayOps
ops) ->
let dest :: String
dest = String
"read_value_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
shape :: String
shape = String
"read_shape_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
arr :: String
arr = String
"read_arr_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
ty :: Type
ty = [C.cty|typename $id:t|]
dims_exps :: [Exp]
dims_exps = [[C.cexp|$id:shape[$int:j]|] | Int
j <- [Int
0 .. Int
rank Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
t' :: Type
t' = (Signedness -> PrimType -> Type) -> (Signedness, PrimType) -> Type
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Signedness -> PrimType -> Type
primAPIType ((Signedness, PrimType) -> Type) -> (Signedness, PrimType) -> Type
forall a b. (a -> b) -> a -> b
$ Text -> (Signedness, PrimType)
scalarToPrim Text
et
new_array :: Text
new_array = ArrayOps -> Text
arrayNew ArrayOps
ops
free_array :: Text
free_array = ArrayOps -> Text
arrayFree ArrayOps
ops
info :: String
info = Text -> String
T.unpack Text
et String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_info"
items :: [BlockItem]
items =
[C.citems|
$ty:ty $id:dest;
typename int64_t $id:shape[$int:rank];
$ty:t' *$id:arr = NULL;
errno = 0;
if (read_array(stdin,
&$id:info,
(void**) &$id:arr,
$id:shape,
$int:rank)
!= 0) {
futhark_panic(1, "Cannot read input #%d of type %s%s (errno: %s).\n",
$int:i,
$string:(T.unpack tname),
$id:info.type_name,
strerror(errno));
}|]
in ( [BlockItem]
items,
[C.cstm|assert(($id:dest = $id:new_array(ctx, $id:arr, $args:dims_exps)) != NULL);|],
[C.cstm|assert($id:free_array(ctx, $id:dest) == 0);|],
[C.cstm|free($id:arr);|],
[C.cexp|$id:dest|]
)
readInputs :: Manifest -> [T.Text] -> [([C.BlockItem], C.Stm, C.Stm, C.Stm, C.Exp)]
readInputs :: Manifest -> [Text] -> [([BlockItem], Stm, Stm, Stm, Exp)]
readInputs Manifest
manifest = (Int -> Text -> ([BlockItem], Stm, Stm, Stm, Exp))
-> [Int] -> [Text] -> [([BlockItem], Stm, Stm, Stm, Exp)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Manifest -> Int -> Text -> ([BlockItem], Stm, Stm, Stm, Exp)
readInput Manifest
manifest) [Int
0 ..]
prepareOutputs :: Manifest -> [T.Text] -> [(C.BlockItem, C.Exp, C.Stm)]
prepareOutputs :: Manifest -> [Text] -> [(BlockItem, Exp, Stm)]
prepareOutputs Manifest
manifest = (Int -> Text -> (BlockItem, Exp, Stm))
-> [Int] -> [Text] -> [(BlockItem, Exp, Stm)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Text -> (BlockItem, Exp, Stm)
forall a. Show a => a -> Text -> (BlockItem, Exp, Stm)
prepareResult [(Int
0 :: Int) ..]
where
prepareResult :: a -> Text -> (BlockItem, Exp, Stm)
prepareResult a
i Text
tname = do
let result :: String
result = String
"result_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
case Text -> Map Text Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
tname (Map Text Type -> Maybe Type) -> Map Text Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Manifest -> Map Text Type
manifestTypes Manifest
manifest of
Maybe Type
Nothing ->
let (Signedness
s, PrimType
pt) = Text -> (Signedness, PrimType)
scalarToPrim Text
tname
ty :: Type
ty = Signedness -> PrimType -> Type
primAPIType Signedness
s PrimType
pt
in ( [C.citem|$ty:ty $id:result;|],
[C.cexp|$id:result|],
[C.cstm|;|]
)
Just (TypeArray Text
t Text
_ Int
_ ArrayOps
ops) ->
( [C.citem|typename $id:t $id:result;|],
[C.cexp|$id:result|],
[C.cstm|assert($id:(arrayFree ops)(ctx, $id:result) == 0);|]
)
Just (TypeOpaque Text
t OpaqueOps
ops) ->
( [C.citem|typename $id:t $id:result;|],
[C.cexp|$id:result|],
[C.cstm|assert($id:(opaqueFree ops)(ctx, $id:result) == 0);|]
)
printStm :: Manifest -> T.Text -> C.Exp -> C.Stm
printStm :: Manifest -> Text -> Exp -> Stm
printStm Manifest
manifest Text
tname Exp
e =
case Text -> Map Text Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
tname (Map Text Type -> Maybe Type) -> Map Text Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Manifest -> Map Text Type
manifestTypes Manifest
manifest of
Maybe Type
Nothing ->
let info :: Text
info = Text
tname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_info"
in [C.cstm|write_scalar(stdout, binary_output, &$id:info, &$exp:e);|]
Just (TypeOpaque Text
desc OpaqueOps
_) ->
[C.cstm|printf("#<opaque %s>", $string:(T.unpack desc));|]
Just (TypeArray Text
_ Text
et Int
rank ArrayOps
ops) ->
let et' :: Type
et' = (Signedness -> PrimType -> Type) -> (Signedness, PrimType) -> Type
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Signedness -> PrimType -> Type
primAPIType ((Signedness, PrimType) -> Type) -> (Signedness, PrimType) -> Type
forall a b. (a -> b) -> a -> b
$ Text -> (Signedness, PrimType)
scalarToPrim Text
et
values_array :: Text
values_array = ArrayOps -> Text
arrayValues ArrayOps
ops
shape_array :: Text
shape_array = ArrayOps -> Text
arrayShape ArrayOps
ops
num_elems :: Exp
num_elems =
[Exp] -> Exp
cproduct [[C.cexp|$id:shape_array(ctx, $exp:e)[$int:i]|] | Int
i <- [Int
0 .. Int
rank Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
info :: Text
info = Text
et Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_info"
in [C.cstm|{
$ty:et' *arr = calloc($exp:num_elems, $id:info.size);
assert(arr != NULL);
assert($id:values_array(ctx, $exp:e, arr) == 0);
write_array(stdout, binary_output, &$id:info, arr,
$id:shape_array(ctx, $exp:e), $int:rank);
free(arr);
}|]
printResult :: Manifest -> [(T.Text, C.Exp)] -> [C.Stm]
printResult :: Manifest -> [(Text, Exp)] -> [Stm]
printResult Manifest
manifest = ((Text, Exp) -> [Stm]) -> [(Text, Exp)] -> [Stm]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, Exp) -> [Stm]
f
where
f :: (Text, Exp) -> [Stm]
f (Text
v, Exp
e) = [Manifest -> Text -> Exp -> Stm
printStm Manifest
manifest Text
v Exp
e, [C.cstm|printf("\n");|]]
cliEntryPoint ::
Manifest -> T.Text -> EntryPoint -> (C.Definition, C.Initializer)
cliEntryPoint :: Manifest -> Text -> EntryPoint -> (Definition, Initializer)
cliEntryPoint Manifest
manifest Text
entry_point_name (EntryPoint Text
cfun [Output]
outputs [Input]
inputs) =
let ([[BlockItem]]
input_items, [Stm]
pack_input, [Stm]
free_input, [Stm]
free_parsed, [Exp]
input_args) =
[([BlockItem], Stm, Stm, Stm, Exp)]
-> ([[BlockItem]], [Stm], [Stm], [Stm], [Exp])
forall a b c d e. [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
unzip5 ([([BlockItem], Stm, Stm, Stm, Exp)]
-> ([[BlockItem]], [Stm], [Stm], [Stm], [Exp]))
-> [([BlockItem], Stm, Stm, Stm, Exp)]
-> ([[BlockItem]], [Stm], [Stm], [Stm], [Exp])
forall a b. (a -> b) -> a -> b
$ Manifest -> [Text] -> [([BlockItem], Stm, Stm, Stm, Exp)]
readInputs Manifest
manifest ([Text] -> [([BlockItem], Stm, Stm, Stm, Exp)])
-> [Text] -> [([BlockItem], Stm, Stm, Stm, Exp)]
forall a b. (a -> b) -> a -> b
$ (Input -> Text) -> [Input] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Text
inputType [Input]
inputs
([BlockItem]
output_decls, [Exp]
output_vals, [Stm]
free_outputs) =
[(BlockItem, Exp, Stm)] -> ([BlockItem], [Exp], [Stm])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(BlockItem, Exp, Stm)] -> ([BlockItem], [Exp], [Stm]))
-> [(BlockItem, Exp, Stm)] -> ([BlockItem], [Exp], [Stm])
forall a b. (a -> b) -> a -> b
$ Manifest -> [Text] -> [(BlockItem, Exp, Stm)]
prepareOutputs Manifest
manifest ([Text] -> [(BlockItem, Exp, Stm)])
-> [Text] -> [(BlockItem, Exp, Stm)]
forall a b. (a -> b) -> a -> b
$ (Output -> Text) -> [Output] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Output -> Text
outputType [Output]
outputs
printstms :: [Stm]
printstms =
Manifest -> [(Text, Exp)] -> [Stm]
printResult Manifest
manifest ([(Text, Exp)] -> [Stm]) -> [(Text, Exp)] -> [Stm]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Exp] -> [(Text, Exp)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Output -> Text) -> [Output] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Output -> Text
outputType [Output]
outputs) [Exp]
output_vals
ctx_ty :: Type
ctx_ty = [C.cty|struct futhark_context|]
sync_ctx :: Text
sync_ctx = Text
"futhark_context_sync" :: T.Text
error_ctx :: Text
error_ctx = Text
"futhark_context_get_error" :: T.Text
cli_entry_point_function_name :: String
cli_entry_point_function_name = String
"futrts_cli_entry_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
entry_point_name
pause_profiling :: Text
pause_profiling = Text
"futhark_context_pause_profiling" :: T.Text
unpause_profiling :: Text
unpause_profiling = Text
"futhark_context_unpause_profiling" :: T.Text
addrOf :: a -> Exp
addrOf a
e = [C.cexp|&$exp:e|]
run_it :: [BlockItem]
run_it =
[C.citems|
int r;
// Run the program once.
$stms:pack_input
if ($id:sync_ctx(ctx) != 0) {
futhark_panic(1, "%s", $id:error_ctx(ctx));
};
// Only profile last run.
if (profile_run) {
$id:unpause_profiling(ctx);
}
t_start = get_wall_time();
r = $id:cfun(ctx,
$args:(map addrOf output_vals),
$args:input_args);
if (r != 0) {
futhark_panic(1, "%s", $id:error_ctx(ctx));
}
if ($id:sync_ctx(ctx) != 0) {
futhark_panic(1, "%s", $id:error_ctx(ctx));
};
if (profile_run) {
$id:pause_profiling(ctx);
}
t_end = get_wall_time();
long int elapsed_usec = t_end - t_start;
if (time_runs && runtime_file != NULL) {
fprintf(runtime_file, "%lld\n", (long long) elapsed_usec);
fflush(runtime_file);
}
$stms:free_input
|]
in ( [C.cedecl|
static void $id:cli_entry_point_function_name($ty:ctx_ty *ctx) {
typename int64_t t_start, t_end;
int time_runs = 0, profile_run = 0;
// We do not want to profile all the initialisation.
$id:pause_profiling(ctx);
// Declare and read input.
set_binary_mode(stdin);
$items:(mconcat input_items)
if (end_of_input(stdin) != 0) {
futhark_panic(1, "Expected EOF on stdin after reading input for \"%s\".\n", $string:(pretty entry_point_name));
}
$items:output_decls
// Warmup run
if (perform_warmup) {
$items:run_it
$stms:free_outputs
}
time_runs = 1;
// Proper run.
for (int run = 0; run < num_runs; run++) {
// Only profile last run.
profile_run = run == num_runs -1;
$items:run_it
if (run < num_runs-1) {
$stms:free_outputs
}
}
// Free the parsed input.
$stms:free_parsed
if (print_result) {
// Print the final result.
if (binary_output) {
set_binary_mode(stdout);
}
$stms:printstms
}
$stms:free_outputs
}|],
[C.cinit|{ .name = $string:(T.unpack entry_point_name),
.fun = $id:cli_entry_point_function_name }|]
)
{-# NOINLINE cliDefs #-}
cliDefs :: [Option] -> Manifest -> T.Text
cliDefs :: [Option] -> Manifest -> Text
cliDefs [Option]
options Manifest
manifest =
let option_parser :: Func
option_parser =
String -> [Option] -> Func
generateOptionParser String
"parse_options" ([Option] -> Func) -> [Option] -> Func
forall a b. (a -> b) -> a -> b
$ [Option]
genericOptions [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
options
([Definition]
cli_entry_point_decls, [Initializer]
entry_point_inits) =
[(Definition, Initializer)] -> ([Definition], [Initializer])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Definition, Initializer)] -> ([Definition], [Initializer]))
-> [(Definition, Initializer)] -> ([Definition], [Initializer])
forall a b. (a -> b) -> a -> b
$
((Text, EntryPoint) -> (Definition, Initializer))
-> [(Text, EntryPoint)] -> [(Definition, Initializer)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> EntryPoint -> (Definition, Initializer))
-> (Text, EntryPoint) -> (Definition, Initializer)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Manifest -> Text -> EntryPoint -> (Definition, Initializer)
cliEntryPoint Manifest
manifest)) ([(Text, EntryPoint)] -> [(Definition, Initializer)])
-> [(Text, EntryPoint)] -> [(Definition, Initializer)]
forall a b. (a -> b) -> a -> b
$
Map Text EntryPoint -> [(Text, EntryPoint)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text EntryPoint -> [(Text, EntryPoint)])
-> Map Text EntryPoint -> [(Text, EntryPoint)]
forall a b. (a -> b) -> a -> b
$ Manifest -> Map Text EntryPoint
manifestEntryPoints Manifest
manifest
in [Definition] -> Text
forall a. Pretty a => a -> Text
prettyText
[C.cunit|
$esc:("#include <getopt.h>")
$esc:("#include <ctype.h>")
$esc:("#include <inttypes.h>")
$esc:("#include <unistd.h>")
$esc:(T.unpack valuesH)
static int binary_output = 0;
static int print_result = 1;
static typename FILE *runtime_file;
static int perform_warmup = 0;
static int num_runs = 1;
// If the entry point is NULL, the program will terminate after doing initialisation and such.
static const char *entry_point = "main";
$esc:(T.unpack tuningH)
$func:option_parser
$edecls:cli_entry_point_decls
typedef void entry_point_fun(struct futhark_context*);
struct entry_point_entry {
const char *name;
entry_point_fun *fun;
};
int main(int argc, char** argv) {
fut_progname = argv[0];
struct futhark_context_config *cfg = futhark_context_config_new();
assert(cfg != NULL);
int parsed_options = parse_options(cfg, argc, argv);
argc -= parsed_options;
argv += parsed_options;
if (argc != 0) {
futhark_panic(1, "Excess non-option: %s\n", argv[0]);
}
struct futhark_context *ctx = futhark_context_new(cfg);
assert (ctx != NULL);
char* error = futhark_context_get_error(ctx);
if (error != NULL) {
futhark_panic(1, "%s", error);
}
struct entry_point_entry entry_points[] = {
$inits:entry_point_inits
};
if (entry_point != NULL) {
int num_entry_points = sizeof(entry_points) / sizeof(entry_points[0]);
entry_point_fun *entry_point_fun = NULL;
for (int i = 0; i < num_entry_points; i++) {
if (strcmp(entry_points[i].name, entry_point) == 0) {
entry_point_fun = entry_points[i].fun;
break;
}
}
if (entry_point_fun == NULL) {
fprintf(stderr, "No entry point '%s'. Select another with --entry-point. Options are:\n",
entry_point);
for (int i = 0; i < num_entry_points; i++) {
fprintf(stderr, "%s\n", entry_points[i].name);
}
return 1;
}
if (isatty(fileno(stdin))) {
fprintf(stderr, "Reading input from TTY.\n");
fprintf(stderr, "Send EOF (CTRL-d) after typing all input values.\n");
}
entry_point_fun(ctx);
if (runtime_file != NULL) {
fclose(runtime_file);
}
char *report = futhark_context_report(ctx);
fputs(report, stderr);
free(report);
}
futhark_context_free(ctx);
futhark_context_config_free(cfg);
return 0;
}|]