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

-- | Code generation for standalone executables.
module Futhark.CodeGen.Backends.GenericC.CLI
  ( cliDefs,
  )
where

import Data.FileEmbed
import Data.List (unzip5)
import Futhark.CodeGen.Backends.GenericC.Options
import Futhark.CodeGen.Backends.SimpleRep
import Futhark.CodeGen.ImpCode
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
"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-sizes",
        optionShortName :: Maybe Char
optionShortName = Maybe Char
forall a. Maybe a
Nothing,
        optionArgument :: OptionArgument
optionArgument = OptionArgument
NoArgument,
        optionDescription :: String
optionDescription = String
"Print all sizes that can be set with --size or --tuning.",
        optionAction :: Stm
optionAction =
          [C.cstm|{
                int n = futhark_get_num_sizes();
                for (int i = 0; i < n; i++) {
                  printf("%s (%s)\n", futhark_get_size_name(i),
                                      futhark_get_size_class(i));
                }
                exit(0);
              }|]
      },
    Option :: String -> Maybe Char -> OptionArgument -> String -> Stm -> Option
Option
      { optionLongName :: String
optionLongName = String
"size",
        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 configurable run-time 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_size(cfg, name, 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_size);
                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);
          }
        }|]

valueDescToCType :: ValueDesc -> C.Type
valueDescToCType :: ValueDesc -> Type
valueDescToCType (ScalarValue PrimType
pt Signedness
signed VName
_) =
  Signedness -> PrimType -> Type
signedPrimTypeToCType Signedness
signed PrimType
pt
valueDescToCType (ArrayValue VName
_ Space
_ PrimType
pt Signedness
signed [DimSize]
shape) =
  let name :: String
name = String
"futhark_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimType -> Signedness -> Int -> String
arrayName PrimType
pt Signedness
signed ([DimSize] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DimSize]
shape)
   in [C.cty|struct $id:name|]

opaqueToCType :: String -> [ValueDesc] -> C.Type
opaqueToCType :: String -> [ValueDesc] -> Type
opaqueToCType String
desc [ValueDesc]
vds =
  let name :: String
name = String
"futhark_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [ValueDesc] -> String
opaqueName String
desc [ValueDesc]
vds
   in [C.cty|struct $id:name|]

externalValueToCType :: ExternalValue -> C.Type
externalValueToCType :: ExternalValue -> Type
externalValueToCType (TransparentValue ValueDesc
vd) = ValueDesc -> Type
valueDescToCType ValueDesc
vd
externalValueToCType (OpaqueValue String
desc [ValueDesc]
vds) = String -> [ValueDesc] -> Type
opaqueToCType String
desc [ValueDesc]
vds

primTypeInfo :: PrimType -> Signedness -> C.Exp
primTypeInfo :: PrimType -> Signedness -> Exp
primTypeInfo (IntType IntType
it) Signedness
t = case (IntType
it, Signedness
t) of
  (IntType
Int8, Signedness
TypeUnsigned) -> [C.cexp|u8_info|]
  (IntType
Int16, Signedness
TypeUnsigned) -> [C.cexp|u16_info|]
  (IntType
Int32, Signedness
TypeUnsigned) -> [C.cexp|u32_info|]
  (IntType
Int64, Signedness
TypeUnsigned) -> [C.cexp|u64_info|]
  (IntType
Int8, Signedness
_) -> [C.cexp|i8_info|]
  (IntType
Int16, Signedness
_) -> [C.cexp|i16_info|]
  (IntType
Int32, Signedness
_) -> [C.cexp|i32_info|]
  (IntType
Int64, Signedness
_) -> [C.cexp|i64_info|]
primTypeInfo (FloatType FloatType
Float32) Signedness
_ = [C.cexp|f32_info|]
primTypeInfo (FloatType FloatType
Float64) Signedness
_ = [C.cexp|f64_info|]
primTypeInfo PrimType
Bool Signedness
_ = [C.cexp|bool_info|]
primTypeInfo PrimType
Cert Signedness
_ = [C.cexp|bool_info|]

readPrimStm :: C.ToIdent a => a -> Int -> PrimType -> Signedness -> C.Stm
readPrimStm :: a -> Int -> PrimType -> Signedness -> Stm
readPrimStm a
place Int
i PrimType
t Signedness
ept =
  [C.cstm|if (read_scalar(stdin, &$exp:(primTypeInfo t ept), &$id:place) != 0) {
            futhark_panic(1, "Error when reading input #%d of type %s (errno: %s).\n",
                          $int:i,
                          $exp:(primTypeInfo t ept).type_name,
                          strerror(errno));
          }|]

readInput :: Int -> ExternalValue -> ([C.BlockItem], C.Stm, C.Stm, C.Stm, C.Exp)
readInput :: Int -> ExternalValue -> ([BlockItem], Stm, Stm, Stm, Exp)
readInput Int
i (OpaqueValue String
desc [ValueDesc]
_) =
  ( [C.citems|futhark_panic(1, "Cannot read input #%d of type %s\n", $int:i, $string:desc);|],
    [C.cstm|;|],
    [C.cstm|;|],
    [C.cstm|;|],
    [C.cexp|NULL|]
  )
readInput Int
i (TransparentValue (ScalarValue PrimType
t Signedness
ept VName
_)) =
  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
   in ( [C.citems|$ty:(primTypeToCType t) $id:dest;
                  $stm:(readPrimStm dest i t ept);|],
        [C.cstm|;|],
        [C.cstm|;|],
        [C.cstm|;|],
        [C.cexp|$id:dest|]
      )
readInput Int
i (TransparentValue (ArrayValue VName
_ Space
_ PrimType
t Signedness
ept [DimSize]
dims)) =
  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

      name :: String
name = PrimType -> Signedness -> Int -> String
arrayName PrimType
t Signedness
ept Int
rank
      arr_ty_name :: String
arr_ty_name = String
"futhark_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
      ty :: Type
ty = [C.cty|struct $id:arr_ty_name|]
      rank :: Int
rank = [DimSize] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DimSize]
dims
      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]]
      dims_s :: String
dims_s = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
rank String
"[]"
      t' :: Type
t' = Signedness -> PrimType -> Type
signedPrimTypeToCType Signedness
ept PrimType
t

      new_array :: String
new_array = String
"futhark_new_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
      free_array :: String
free_array = String
"futhark_free_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name

      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,
                          &$exp:(primTypeInfo t ept),
                          (void**) &$id:arr,
                          $id:shape,
                          $int:(length dims))
               != 0) {
             futhark_panic(1, "Cannot read input #%d of type %s%s (errno: %s).\n",
                           $int:i,
                           $string:dims_s,
                           $exp:(primTypeInfo t ept).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 :: [ExternalValue] -> [([C.BlockItem], C.Stm, C.Stm, C.Stm, C.Exp)]
readInputs :: [ExternalValue] -> [([BlockItem], Stm, Stm, Stm, Exp)]
readInputs = (Int -> ExternalValue -> ([BlockItem], Stm, Stm, Stm, Exp))
-> [Int] -> [ExternalValue] -> [([BlockItem], Stm, Stm, Stm, Exp)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ExternalValue -> ([BlockItem], Stm, Stm, Stm, Exp)
readInput [Int
0 ..]

prepareOutputs :: [ExternalValue] -> [(C.BlockItem, C.Exp, C.Stm)]
prepareOutputs :: [ExternalValue] -> [(BlockItem, Exp, Stm)]
prepareOutputs = (Int -> ExternalValue -> (BlockItem, Exp, Stm))
-> [Int] -> [ExternalValue] -> [(BlockItem, Exp, Stm)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ExternalValue -> (BlockItem, Exp, Stm)
forall a. Show a => a -> ExternalValue -> (BlockItem, Exp, Stm)
prepareResult [(Int
0 :: Int) ..]
  where
    prepareResult :: a -> ExternalValue -> (BlockItem, Exp, Stm)
prepareResult a
i ExternalValue
ev = do
      let ty :: Type
ty = ExternalValue -> Type
externalValueToCType ExternalValue
ev
          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 ExternalValue
ev of
        TransparentValue ScalarValue {} ->
          ( [C.citem|$ty:ty $id:result;|],
            [C.cexp|$id:result|],
            [C.cstm|;|]
          )
        TransparentValue (ArrayValue VName
_ Space
_ PrimType
t Signedness
ept [DimSize]
dims) ->
          let name :: String
name = PrimType -> Signedness -> Int -> String
arrayName PrimType
t Signedness
ept (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [DimSize] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DimSize]
dims
              free_array :: String
free_array = String
"futhark_free_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
           in ( [C.citem|$ty:ty *$id:result;|],
                [C.cexp|$id:result|],
                [C.cstm|assert($id:free_array(ctx, $id:result) == 0);|]
              )
        OpaqueValue String
desc [ValueDesc]
vds ->
          let free_opaque :: String
free_opaque = String
"futhark_free_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [ValueDesc] -> String
opaqueName String
desc [ValueDesc]
vds
           in ( [C.citem|$ty:ty *$id:result;|],
                [C.cexp|$id:result|],
                [C.cstm|assert($id:free_opaque(ctx, $id:result) == 0);|]
              )

printPrimStm :: (C.ToExp a, C.ToExp b) => a -> b -> PrimType -> Signedness -> C.Stm
printPrimStm :: a -> b -> PrimType -> Signedness -> Stm
printPrimStm a
dest b
val PrimType
bt Signedness
ept =
  [C.cstm|write_scalar($exp:dest, binary_output, &$exp:(primTypeInfo bt ept), &$exp:val);|]

-- | Return a statement printing the given external value.
printStm :: ExternalValue -> C.Exp -> C.Stm
printStm :: ExternalValue -> Exp -> Stm
printStm (OpaqueValue String
desc [ValueDesc]
_) Exp
_ =
  [C.cstm|printf("#<opaque %s>", $string:desc);|]
printStm (TransparentValue (ScalarValue PrimType
bt Signedness
ept VName
_)) Exp
e =
  Exp -> Exp -> PrimType -> Signedness -> Stm
forall a b.
(ToExp a, ToExp b) =>
a -> b -> PrimType -> Signedness -> Stm
printPrimStm [C.cexp|stdout|] Exp
e PrimType
bt Signedness
ept
printStm (TransparentValue (ArrayValue VName
_ Space
_ PrimType
bt Signedness
ept [DimSize]
shape)) Exp
e =
  let values_array :: String
values_array = String
"futhark_values_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
      shape_array :: String
shape_array = String
"futhark_shape_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
      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]]
   in [C.cstm|{
        $ty:bt' *arr = calloc(sizeof($ty:bt'), $exp:num_elems);
        assert(arr != NULL);
        assert($id:values_array(ctx, $exp:e, arr) == 0);
        write_array(stdout, binary_output, &$exp:(primTypeInfo bt ept), arr,
                    $id:shape_array(ctx, $exp:e), $int:rank);
        free(arr);
      }|]
  where
    rank :: Int
rank = [DimSize] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DimSize]
shape
    bt' :: Type
bt' = PrimType -> Type
primTypeToCType PrimType
bt
    name :: String
name = PrimType -> Signedness -> Int -> String
arrayName PrimType
bt Signedness
ept Int
rank

printResult :: [(ExternalValue, C.Exp)] -> [C.Stm]
printResult :: [(ExternalValue, Exp)] -> [Stm]
printResult = ((ExternalValue, Exp) -> [Stm]) -> [(ExternalValue, Exp)] -> [Stm]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ExternalValue, Exp) -> [Stm]
f
  where
    f :: (ExternalValue, Exp) -> [Stm]
f (ExternalValue
v, Exp
e) = [ExternalValue -> Exp -> Stm
printStm ExternalValue
v Exp
e, [C.cstm|printf("\n");|]]

cliEntryPoint ::
  Name ->
  FunctionT a ->
  (C.Definition, C.Initializer)
cliEntryPoint :: Name -> FunctionT a -> (Definition, Initializer)
cliEntryPoint Name
fname (Function Bool
_ [Param]
_ [Param]
_ Code a
_ [ExternalValue]
results [ExternalValue]
args) =
  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
$ [ExternalValue] -> [([BlockItem], Stm, Stm, Stm, Exp)]
readInputs [ExternalValue]
args

      ([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
$ [ExternalValue] -> [(BlockItem, Exp, Stm)]
prepareOutputs [ExternalValue]
results

      printstms :: [Stm]
printstms = [(ExternalValue, Exp)] -> [Stm]
printResult ([(ExternalValue, Exp)] -> [Stm])
-> [(ExternalValue, Exp)] -> [Stm]
forall a b. (a -> b) -> a -> b
$ [ExternalValue] -> [Exp] -> [(ExternalValue, Exp)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ExternalValue]
results [Exp]
output_vals

      ctx_ty :: Type
ctx_ty = [C.cty|struct futhark_context|]
      sync_ctx :: Name
sync_ctx = Name
"futhark_context_sync" :: Name
      error_ctx :: Name
error_ctx = Name
"futhark_context_get_error" :: Name

      entry_point_name :: String
entry_point_name = Name -> String
nameToString Name
fname
      cli_entry_point_function_name :: String
cli_entry_point_function_name = String
"futrts_cli_entry_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
entry_point_name
      entry_point_function_name :: String
entry_point_function_name = String
"futhark_entry_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
entry_point_name

      pause_profiling :: Name
pause_profiling = Name
"futhark_context_pause_profiling" :: Name
      unpause_profiling :: Name
unpause_profiling = Name
"futhark_context_unpause_profiling" :: Name

      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:entry_point_function_name(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:(quote (pretty fname)));
    }

    $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

    // Print the final result.
    if (binary_output) {
      set_binary_mode(stdout);
    }
    $stms:printstms

    $stms:free_outputs
  }|],
        [C.cinit|{ .name = $string:entry_point_name,
                      .fun = $id:cli_entry_point_function_name }|]
      )

{-# NOINLINE cliDefs #-}

-- | Generate Futhark standalone executable code.
cliDefs :: [Option] -> Functions a -> [C.Definition]
cliDefs :: [Option] -> Functions a -> [Definition]
cliDefs [Option]
options (Functions [(Name, Function a)]
funs) =
  let values_h :: String
values_h = $(embedStringFile "rts/c/values.h")
      tuning_h :: String
tuning_h = $(embedStringFile "rts/c/tuning.h")

      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
$ ((Name, Function a) -> (Definition, Initializer))
-> [(Name, Function a)] -> [(Definition, Initializer)]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Function a -> (Definition, Initializer))
-> (Name, Function a) -> (Definition, Initializer)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> Function a -> (Definition, Initializer)
forall a. Name -> FunctionT a -> (Definition, Initializer)
cliEntryPoint) [(Name, Function a)]
funs
   in [C.cunit|
$esc:("#include <getopt.h>")
$esc:("#include <ctype.h>")
$esc:("#include <inttypes.h>")

$esc:values_h

static int binary_output = 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:tuning_h

$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;
    }

    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;
}|]