{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TupleSections #-}

-- | Code generation for standalone executables.
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.Options
import Futhark.CodeGen.Backends.SimpleRep
  ( cproduct,
    primAPIType,
    primStorageType,
    scalarToPrim,
  )
import Futhark.CodeGen.RTS.C (tuningH, valuesH)
import Futhark.Manifest
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);
                                print_report = 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);
                   print_report = 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);
                }}|]
      },
    Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
      { optionLongName :: String
optionLongName = String
"cache-file",
        optionShortName :: Maybe Char
optionShortName = Maybe Char
forall a. Maybe a
Nothing,
        optionArgument :: OptionArgument
optionArgument = String -> OptionArgument
RequiredArgument String
"FILE",
        optionDescription :: String
optionDescription = String
"Store program cache here.",
        optionAction :: Stm
optionAction =
          [C.cstm|futhark_context_config_set_cache_file(cfg, optarg);|]
      }
  ]
  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
_ Maybe RecordOps
_) ->
      ( [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 (errno: %s).\n",
                               $int:i,
                               $string:(T.unpack tname),
                               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 Maybe RecordOps
_) ->
          ( [C.citem|typename $id:t $id:result;|],
            [C.cexp|$id:result|],
            [C.cstm|assert($id:(opaqueFree ops)(ctx, $id:result) == 0);|]
          )

-- | Return a statement printing the given external value.
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
_ Maybe RecordOps
_) ->
      [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 #-}

-- | Generate Futhark standalone executable code.
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 int print_report = 0;
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);
    }

    if (print_report) {
      char *report = futhark_context_report(ctx);
      fputs(report, stderr);
      free(report);
    }
  }

  futhark_context_free(ctx);
  futhark_context_config_free(cfg);
  return 0;
}|]