{-# LANGUAGE QuasiQuotes #-}
module Futhark.CodeGen.Backends.GenericC.Options
( Option (..)
, OptionArgument (..)
, generateOptionParser
)
where
import Data.Maybe
import qualified Language.C.Syntax as C
import qualified Language.C.Quote.C as C
data Option = Option { Option -> String
optionLongName :: String
, Option -> Maybe Char
optionShortName :: Maybe Char
, Option -> OptionArgument
optionArgument :: OptionArgument
, Option -> Stm
optionAction :: C.Stm
}
data OptionArgument = NoArgument
| RequiredArgument String
| OptionalArgument
generateOptionParser :: String -> [Option] -> C.Func
generateOptionParser :: String -> [Option] -> Func
generateOptionParser String
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} };
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: %s\n", fut_progname, $string:option_descriptions);
futhark_panic(1, "Unknown option: %s\n", argv[optind-1]);
}
}
return optind;
}
|]
where chosen_option :: String
chosen_option = String
"ch"
option_string :: String
option_string = Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: [Option] -> String
optionString [Option]
options
option_applications :: [Stm]
option_applications = String -> [Option] -> [Stm]
optionApplications String
chosen_option [Option]
options
option_fields :: [Initializer]
option_fields = [Option] -> [Initializer]
optionFields [Option]
options
option_descriptions :: String
option_descriptions = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
describeOption [Option]
options
describeOption :: Option -> String
describeOption :: Option -> String
describeOption Option
opt =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"["
, String -> (Char -> String) -> Maybe Char -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Char
c -> String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/") (Maybe Char -> String) -> Maybe Char -> String
forall a b. (a -> b) -> a -> b
$ Option -> Maybe Char
optionShortName Option
opt
, String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Option -> String
optionLongName Option
opt
, case Option -> OptionArgument
optionArgument Option
opt of
OptionArgument
NoArgument -> String
""
RequiredArgument String
what -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
what
OptionArgument
OptionalArgument -> String
" [ARG]"
, String
"]"
]
optionFields :: [Option] -> [C.Initializer]
optionFields :: [Option] -> [Initializer]
optionFields = (Int -> Option -> Initializer)
-> [Int] -> [Option] -> [Initializer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Option -> Initializer
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 :: String
arg = case Option -> OptionArgument
optionArgument Option
option of
OptionArgument
NoArgument -> String
"no_argument"
RequiredArgument String
_ -> String
"required_argument"
OptionArgument
OptionalArgument -> String
"optional_argument"
optionApplications :: String -> [Option] -> [C.Stm]
optionApplications :: String -> [Option] -> [Stm]
optionApplications String
chosen_option = (Int -> Option -> Stm) -> [Int] -> [Option] -> [Stm]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Option -> Stm
forall a. (Show a, Integral a) => a -> Option -> Stm
check [(Int
1::Int)..]
where check :: a -> Option -> Stm
check a
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] -> String
optionString = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([Option] -> [String]) -> [Option] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Option -> Maybe String) -> [Option] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Option -> Maybe String
optionStringChunk
where optionStringChunk :: Option -> Maybe String
optionStringChunk Option
option = do
Char
short <- Option -> Maybe Char
optionShortName Option
option
String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Char
short Char -> String -> String
forall a. a -> [a] -> [a]
:
case Option -> OptionArgument
optionArgument Option
option of
OptionArgument
NoArgument -> String
""
RequiredArgument String
_ -> String
":"
OptionArgument
OptionalArgument -> String
"::"