{-# LANGUAGE QuasiQuotes #-}
module Futhark.CodeGen.Backends.GenericC.Options
( Option (..),
OptionArgument (..),
generateOptionParser,
)
where
import Data.Char (isSpace)
import Data.Function ((&))
import Data.List (intercalate)
import Data.Maybe
import Language.C.Quote.C qualified as C
import Language.C.Syntax qualified as C
data Option = Option
{ Option -> [Char]
optionLongName :: String,
Option -> Maybe Char
optionShortName :: Maybe Char,
Option -> OptionArgument
optionArgument :: OptionArgument,
Option -> [Char]
optionDescription :: String,
Option -> Stm
optionAction :: C.Stm
}
data OptionArgument
= NoArgument
|
RequiredArgument String
| OptionalArgument
generateOptionParser :: String -> [Option] -> C.Func
generateOptionParser :: [Char] -> [Option] -> Func
generateOptionParser [Char]
fname [Option]
options =
[C.cfun|int $id:fname(struct futhark_context_config *cfg, int argc, char* const argv[]) {
int $id:chosen_option;
static struct option long_options[] = { $inits:option_fields, {0, 0, 0, 0} };
static char* option_descriptions = $string:option_descriptions;
while (($id:chosen_option =
getopt_long(argc, argv, $string:option_string, long_options, NULL)) != -1) {
$stms:option_applications
if ($id:chosen_option == ':') {
futhark_panic(-1, "Missing argument for option %s\n", argv[optind-1]);
}
if ($id:chosen_option == '?') {
fprintf(stderr, "Usage: %s [OPTIONS]...\nOptions:\n\n%s\n", fut_progname, $string:option_descriptions);
futhark_panic(1, "Unknown option: %s\n", argv[optind-1]);
}
}
return optind;
}
|]
where
chosen_option :: [Char]
chosen_option = [Char]
"ch"
option_string :: [Char]
option_string = Char
':' forall a. a -> [a] -> [a]
: [Option] -> [Char]
optionString [Option]
options
option_applications :: [Stm]
option_applications = [Char] -> [Option] -> [Stm]
optionApplications [Char]
chosen_option [Option]
options
option_fields :: [Initializer]
option_fields = [Option] -> [Initializer]
optionFields [Option]
options
option_descriptions :: [Char]
option_descriptions = [Option] -> [Char]
describeOptions [Option]
options
trim :: String -> String
trim :: [Char] -> [Char]
trim = [Char] -> [Char]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
f
where
f :: [Char] -> [Char]
f = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
describeOptions :: [Option] -> String
describeOptions :: [Option] -> [Char]
describeOptions [Option]
opts =
let
in [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Option, [Char]) -> [Char]
extendDesc [(Option, [Char])]
with_short_descs
where
with_short_descs :: [(Option, [Char])]
with_short_descs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Option
opt -> (Option
opt, Option -> [Char]
shortDesc Option
opt)) [Option]
opts
max_short_desc_len :: Int
max_short_desc_len = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Option, [Char])]
with_short_descs
extendDesc :: (Option, String) -> String
extendDesc :: (Option, [Char]) -> [Char]
extendDesc (Option
opt, [Char]
short) =
forall a. Int -> [a] -> [a]
take (Int
max_short_desc_len forall a. Num a => a -> a -> a
+ Int
1) ([Char]
short forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
' ')
forall a. [a] -> [a] -> [a]
++ ( Option -> [Char]
optionDescription Option
opt
forall a b. a -> (a -> b) -> b
& [Char] -> [[Char]]
lines
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> [Char]
trim
forall a b. a -> (a -> b) -> b
& forall a. [a] -> [[a]] -> [a]
intercalate (Char
'\n' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
max_short_desc_len forall a. Num a => a -> a -> a
+ Int
1) Char
' ')
)
shortDesc :: Option -> String
shortDesc :: Option -> [Char]
shortDesc Option
opt =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
" ",
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\Char
c -> [Char]
"-" forall a. [a] -> [a] -> [a]
++ [Char
c] forall a. [a] -> [a] -> [a]
++ [Char]
"/") forall a b. (a -> b) -> a -> b
$ Option -> Maybe Char
optionShortName Option
opt,
[Char]
"--" forall a. [a] -> [a] -> [a]
++ Option -> [Char]
optionLongName Option
opt,
case Option -> OptionArgument
optionArgument Option
opt of
OptionArgument
NoArgument -> [Char]
""
RequiredArgument [Char]
what -> [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
what
OptionArgument
OptionalArgument -> [Char]
" [ARG]"
]
optionFields :: [Option] -> [C.Initializer]
optionFields :: [Option] -> [Initializer]
optionFields = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. (Show a, Integral a) => a -> Option -> Initializer
field [(Int
1 :: Int) ..]
where
field :: a -> Option -> Initializer
field a
i Option
option =
[C.cinit| { $string:(optionLongName option), $id:arg, NULL, $int:i } |]
where
arg :: [Char]
arg = case Option -> OptionArgument
optionArgument Option
option of
OptionArgument
NoArgument -> [Char]
"no_argument" :: String
RequiredArgument [Char]
_ -> [Char]
"required_argument"
OptionArgument
OptionalArgument -> [Char]
"optional_argument"
optionApplications :: String -> [Option] -> [C.Stm]
optionApplications :: [Char] -> [Option] -> [Stm]
optionApplications [Char]
chosen_option = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {p}. (Show p, Integral p) => p -> Option -> Stm
check [(Int
1 :: Int) ..]
where
check :: p -> Option -> Stm
check p
i Option
option =
[C.cstm|if ($exp:cond) $stm:(optionAction option)|]
where
cond :: Exp
cond = case Option -> Maybe Char
optionShortName Option
option of
Maybe Char
Nothing -> [C.cexp|$id:chosen_option == $int:i|]
Just Char
c ->
[C.cexp|($id:chosen_option == $int:i) ||
($id:chosen_option == $char:c)|]
optionString :: [Option] -> String
optionString :: [Option] -> [Char]
optionString = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Option -> Maybe [Char]
optionStringChunk
where
optionStringChunk :: Option -> Maybe [Char]
optionStringChunk Option
option = do
Char
short <- Option -> Maybe Char
optionShortName Option
option
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
Char
short
forall a. a -> [a] -> [a]
: case Option -> OptionArgument
optionArgument Option
option of
OptionArgument
NoArgument -> [Char]
""
RequiredArgument [Char]
_ -> [Char]
":"
OptionArgument
OptionalArgument -> [Char]
"::"