%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 1994-1999,2001-2007, 2011 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING in the Mercury distribution. %---------------------------------------------------------------------------% % % File: getopt.m. % Authors: fjh, zs. % Stability: medium. % % This module exports the predicate process_options/4, which can be % used to parse command-line options. % % This version allows both short (single-character) options and GNU-style long % options. It also has the GNU extension of recognizing options anywhere in % the command-line, not just at the start. % % To use this module, you must provide an `option' type which % is an enumeration of all your different options. % You must provide predicates `short_option(Char, Option)' % and `long_option(String, Option)' which convert the short % and/or long names for the option to this enumeration type. % (An option can have as many names as you like, long or short.) % You must provide a predicate `option_default(Option, OptionData)' % which specifies both the type and the default value for every option. % You may optionally provide a predicate `special_handler(Option, % SpecialData, OptionTable, MaybeOptionTable)' for handling special % option types. (See below.) % % We support the following "simple" option types: % % - bool % - int % - maybe_int (which have a value of `no' or `yes(int)') % - string % - maybe_string (which have a value of `no' or `yes(string)') % % We also support one "accumulating" option type: % % - accumulating (which accumulates a list of strings) % % And the following "special" option types: % % - special % - bool_special % - int_special % - string_special % - maybe_string_special % % A further special option, file_special, is supported only by the getopt_io % module, because it requires process_options to take a pair of I/O state % arguments. % % For the "simple" option types, if there are multiple occurrences of the same % option on the command-line, then the last (right-most) occurrence will take % precedence. For "accumulating" options, multiple occurrences will be % appended together into a list. % % The "special" option types are handled by a special option handler (see % `special_handler' below), which may perform arbitrary modifications to the % option_table. For example, an option which is not yet implemented could be % handled by a special handler which produces an error report, or an option % which is a synonym for a set of more "primitive" options could be handled by % a special handler which sets those "primitive" options. % % It is an error to use a "special" option for which there is no handler, or % for which the handler fails. % % Boolean (i.e. bool or bool_special), maybe_int, maybe_string % and accumulating options can be negated. Negating an accumulating % option empties the accumulated list of strings. % Single-character options can be negated by following them % with another `-', e.g. `-x-' will negate the `-x' option. % Long options can be negated by preceding them with `--no-', % e.g. `--no-foo' will negate the `--foo' option. % % Note that arguments following an option may be separated from the option by % either whitespace or an equals, `=', character, e.g. `--foo 3' and `--foo=3' % both specify the option `--foo' with the integer argument `3'. % % If the argument `--' is encountered on the command-line then option % processing will immediately terminate, without processing any remaining % options. % %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- module getopt. :- interface. :- import_module bool. :- import_module char. :- import_module list. :- import_module map. :- import_module maybe. :- import_module set. % process_options(OptionOps, Args, NonOptionArgs, Result) % process_options(OptionOps, Args, OptionArgs, NonOptionArgs, Result) % % Scans through 'Args' looking for options, places all the option % arguments in `OptionArgs', places all the non-option arguments in % 'NonOptionArgs', and records the options in the `OptionTable'. % `OptionTable' is a map from a user-defined option type to option_data. % If an invalid option is encountered, we return `error(Message)' % otherwise we return `ok(OptionTable)' in 'Result'. % % The argument `OptionOps' is a structure holding three or four % predicates used to categorize a set of options. Their % interfaces should be like these: % % :- pred short_option(char::in, option::out) is semidet. % True if the character names a valid single-character option. % % :- pred long_option(string::in, option::out) is semidet. % True if the string names a valid long option. % % :- pred option_default(option::out, option_data::out) is multi. % Nondeterministically returns all the options with their % corresponding types and default values. % % :- pred special_handler(option::in, special_data::in, % option_table::in, maybe_option_table(_)::out) is semidet. % This predicate is invoked whenever getopt finds an option % (long or short) designated as special, with special_data holding % the argument of the option (if any). The predicate can change the % option table in arbitrary ways in the course of handling the option, % or it can return an error message. % The canonical examples of special options are -O options in compilers, % which set many other options at once. :- pred process_options(option_ops(OptionType)::in(option_ops), list(string)::in, list(string)::out, maybe_option_table(OptionType)::out) is det. :- pred process_options(option_ops(OptionType)::in(option_ops), list(string)::in, list(string)::out, list(string)::out, maybe_option_table(OptionType)::out) is det. % process_options_track(OptionOps, Args, OptionArgs, % NonOptionArgs, OptionTable0, Result, OptionsSet) :- pred process_options_track( option_ops_track(OptionType)::in(option_ops_track), list(string)::in, list(string)::out, list(string)::out, option_table(OptionType)::in, maybe_option_table(OptionType)::out, set(OptionType)::out) is det. % Variants of the above that return structured errors. % These behave as the above versions except that any error values returned are % members of the option_error/1 type rather than strings. :- pred process_options_se(option_ops(OptionType)::in(option_ops), list(string)::in, list(string)::out, maybe_option_table_se(OptionType)::out) is det. :- pred process_options_se(option_ops(OptionType)::in(option_ops), list(string)::in, list(string)::out, list(string)::out, maybe_option_table_se(OptionType)::out) is det. :- pred process_options_track_se( option_ops_track(OptionType)::in(option_ops_track), list(string)::in, list(string)::out, list(string)::out, option_table(OptionType)::in, maybe_option_table_se(OptionType)::out, set(OptionType)::out) is det. :- pred init_option_table( pred(OptionType, option_data)::in(pred(out, out) is nondet), option_table(OptionType)::out) is det. :- pred init_option_table_multi( pred(OptionType, option_data)::in(pred(out, out) is multi), option_table(OptionType)::out) is det. :- type option_ops(OptionType) ---> option_ops( pred(char, OptionType), % short_option pred(string, OptionType), % long_option pred(OptionType, option_data) % option_default ) ; option_ops( pred(char, OptionType), % short_option pred(string, OptionType), % long_option pred(OptionType, option_data), % option_default pred(OptionType, special_data, % special option handler option_table(OptionType), maybe_option_table(OptionType)) ) ; option_ops_multi( pred(char, OptionType), % short_option pred(string, OptionType), % long_option pred(OptionType, option_data) % option_default ) ; option_ops_multi( pred(char, OptionType), % short_option pred(string, OptionType), % long_option pred(OptionType, option_data), % option_default pred(OptionType, special_data, % special option handler option_table(OptionType), maybe_option_table(OptionType)) ). :- type option_ops_track(OptionType) ---> option_ops_track( pred(char, OptionType), % short_option pred(string, OptionType), % long_option pred(OptionType, special_data, % special option handler option_table(OptionType), maybe_option_table(OptionType), set(OptionType)) ). :- inst option_ops == bound(( option_ops( pred(in, out) is semidet, % short_option pred(in, out) is semidet, % long_option pred(out, out) is nondet % option_default ) ; option_ops_multi( pred(in, out) is semidet, % short_option pred(in, out) is semidet, % long_option pred(out, out) is multi % option_default ) ; option_ops( pred(in, out) is semidet, % short_option pred(in, out) is semidet, % long_option pred(out, out) is nondet, % option_default pred(in, in, in, out) is semidet % special handler ) ; option_ops_multi( pred(in, out) is semidet, % short_option pred(in, out) is semidet, % long_option pred(out, out) is multi, % option_default pred(in, in, in, out) is semidet % special handler ) )). :- inst option_ops_track == bound(( option_ops_track( pred(in, out) is semidet, % short_option pred(in, out) is semidet, % long_option pred(in, in, in, out, out) is semidet % special handler ) )). :- type option_data ---> bool(bool) ; int(int) ; string(string) ; maybe_int(maybe(int)) ; maybe_string(maybe(string)) ; accumulating(list(string)) ; special ; bool_special ; int_special ; string_special ; maybe_string_special. :- type special_data ---> none ; bool(bool) ; int(int) ; string(string) ; maybe_string(maybe(string)). :- type option_table(OptionType) == map(OptionType, option_data). :- type maybe_option_table(OptionType) ---> ok(option_table(OptionType)) ; error(string). :- type maybe_option_table_se(OptionType) ---> ok(option_table(OptionType)) ; error(option_error(OptionType)). :- type option_error(OptionType) ---> unrecognized_option(string) % An option that is not recognized appeared on the command line. % The argument gives the option as it appeared on the command line. ; option_error(OptionType, string, option_error_reason). % An error occurred with a specific option. The first two % arguments identify the option enumeration value and the string % that appeared on the command line for that option respectively. % The third argument describes the nature of the error with that % option. :- type option_error_reason ---> unknown_type % No type for this option has been specified in the % `option_default'/2 predicate. ; requires_argument % The option requires an argument but it occurred on the command % line without one. ; does_not_allow_argument(string) % The option does not allow an argument but it was provided with % one on the command line. % The argument gives the contents of the argument position on the % command line. ; cannot_negate % The option cannot be negated but its negated form appeared on the % command line. ; special_handler_failed % The special option handler predicate for the option failed. ; special_handler_missing % A special option handler predicate was not provided % for the option. ; special_handler_error(string) % The special option handler predicate for the option returned an % error. % The argument is a string describing the error. ; requires_numeric_argument(string). % The option requires a numeric argument but it occurred on the % command line with a non-numeric argument. % The argument gives the contents of the argument position on the % command line. :- func option_error_to_string(option_error(OptionType)) = string. % The following three predicates search the option table for % an option of the specified type; if it is not found, they % report an error by calling error/1. :- pred lookup_bool_option(option_table(Option)::in, Option::in, bool::out) is det. :- func lookup_bool_option(option_table(Option), Option) = bool. :- pred lookup_int_option(option_table(Option)::in, Option::in, int::out) is det. :- func lookup_int_option(option_table(Option), Option) = int. :- pred lookup_string_option(option_table(Option)::in, Option::in, string::out) is det. :- func lookup_string_option(option_table(Option), Option) = string. :- pred lookup_maybe_int_option(option_table(Option)::in, Option::in, maybe(int)::out) is det. :- func lookup_maybe_int_option(option_table(Option), Option) = maybe(int). :- pred lookup_maybe_string_option(option_table(Option)::in, Option::in, maybe(string)::out) is det. :- func lookup_maybe_string_option(option_table(Option), Option) = maybe(string). :- pred lookup_accumulating_option(option_table(Option)::in, Option::in, list(string)::out) is det. :- func lookup_accumulating_option(option_table(Option), Option) = list(string). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module pair. :- import_module require. :- import_module solutions. :- import_module string. %---------------------------------------------------------------------------% % Please keep the differences between this module and getopt_io.m to the % minimum. Most changes should done in both modules. :- type option_ops_special(OptionType) ---> none ; notrack( pred(OptionType, special_data, option_table(OptionType), maybe_option_table(OptionType)) ) ; track( pred(OptionType, special_data, option_table(OptionType), maybe_option_table(OptionType), set(OptionType)) ). :- type option_ops_internal(OptionType) ---> option_ops_internal( short_option :: pred(char, OptionType), long_option :: pred(string, OptionType), special_handler :: option_ops_special(OptionType) ). :- inst option_ops_internal == bound(( option_ops_internal( pred(in, out) is semidet, % short_option pred(in, out) is semidet, % long_option bound(( % special handler, if any none ; notrack(pred(in, in, in, out) is semidet) ; track(pred(in, in, in, out, out) is semidet) )) ) )). init_option_table(OptionDefaultsPred, OptionTable) :- solutions((pred(OptionDataPair::out) is nondet :- OptionDataPair = Option - OptionData, OptionDefaultsPred(Option, OptionData) ), OptionDefaultsList), map.from_assoc_list(OptionDefaultsList, OptionTable). init_option_table_multi(OptionDefaultsPred, OptionTable) :- solutions((pred(OptionDataPair::out) is multi :- OptionDataPair = Option - OptionData, OptionDefaultsPred(Option, OptionData) ), OptionDefaultsList), map.from_assoc_list(OptionDefaultsList, OptionTable). process_options(OptionOps, Args0, NonOptionArgs, Result) :- process_options_se(OptionOps, Args0, NonOptionArgs, Result0), ( Result0 = ok(OptionTable), Result = ok(OptionTable) ; Result0 = error(Error), Msg = option_error_to_string(Error), Result = error(Msg) ). process_options(OptionOps, Args0, OptionArgs, NonOptionArgs, Result) :- process_options_se(OptionOps, Args0, OptionArgs, NonOptionArgs, Result0), ( Result0 = ok(OptionTable), Result = ok(OptionTable) ; Result0 = error(Error), Msg = option_error_to_string(Error), Result = error(Msg) ). process_options_track(OptionOps, Args0, OptionArgs, NonOptionArgs, OptionTable0, Result, OptionsSet) :- process_options_track_se(OptionOps, Args0, OptionArgs, NonOptionArgs, OptionTable0, Result0, OptionsSet), ( Result0 = ok(OptionTable), Result = ok(OptionTable) ; Result0 = error(Error), Msg = option_error_to_string(Error), Result = error(Msg) ). process_options_se(OptionOps, Args0, NonOptionArgs, Result) :- process_options_se(OptionOps, Args0, _OptionArgs, NonOptionArgs, Result). process_options_se(OptionOps, Args0, OptionArgs, NonOptionArgs, Result) :- ( OptionOps = option_ops(Short, Long, Defaults), MaybeSpecial = none, init_option_table(Defaults, OptionTable0) ; OptionOps = option_ops(Short, Long, Defaults, Special), MaybeSpecial = notrack(Special), init_option_table(Defaults, OptionTable0) ; OptionOps = option_ops_multi(Short, Long, Defaults), MaybeSpecial = none, init_option_table_multi(Defaults, OptionTable0) ; OptionOps = option_ops_multi(Short, Long, Defaults, Special), MaybeSpecial = notrack(Special), init_option_table_multi(Defaults, OptionTable0) ), Internal = option_ops_internal(Short, Long, MaybeSpecial), process_arguments(Args0, NonOptionArgs, Internal, [], RevOptionArgs, OptionTable0, Result, set.init, _OptionsSet), OptionArgs = list.reverse(RevOptionArgs). process_options_track_se(OptionOps, Args0, OptionArgs, NonOptionArgs, OptionTable0, Result, OptionsSet) :- OptionOps = option_ops_track(Short, Long, Special), Internal = option_ops_internal(Short, Long, track(Special)), process_arguments(Args0, NonOptionArgs, Internal, [], RevOptionArgs, OptionTable0, Result, set.init, OptionsSet), OptionArgs = list.reverse(RevOptionArgs). :- pred process_arguments(list(string)::in, list(string)::out, option_ops_internal(OptionType)::in(option_ops_internal), list(string)::in, list(string)::out, option_table(OptionType)::in, maybe_option_table_se(OptionType)::out, set(OptionType)::in, set(OptionType)::out) is det. process_arguments([], [], _, OptionArgs, OptionArgs, OptionTable, ok(OptionTable), !OptionsSet). process_arguments([Option | Args0], Args, OptionOps, OptionArgs0, OptionArgs, OptionTable0, Result, !OptionsSet) :- ( if Option = "--" then % "--" terminates option processing OptionArgs = OptionArgs0, Args = Args0, Result = ok(OptionTable0) else if string.append("--no-", LongOption, Option) then LongOptionPred = OptionOps ^ long_option, ( if LongOptionPred(LongOption, Flag) then OptName = "--" ++ LongOption, process_negated_option(OptName, Flag, OptionOps, OptionTable0, Result1, !OptionsSet), ( Result1 = ok(OptionTable1), process_arguments(Args0, Args, OptionOps, [Option | OptionArgs0], OptionArgs, OptionTable1, Result, !OptionsSet) ; Result1 = error(_), Result = Result1, OptionArgs = OptionArgs0, Args = Args0 ) else Error = unrecognized_option(Option), Result = error(Error), OptionArgs = OptionArgs0, Args = Args0 ) else if string.append("--", LongOptionStr, Option) then LongOptionPred = OptionOps ^ long_option, ( if string.sub_string_search(LongOptionStr, "=", OptionLen) then string.split(LongOptionStr, OptionLen, LongOption, EqualOptionArg), ( if string.first_char(EqualOptionArg, '=', OptionArg) then MaybeArg = yes(OptionArg) else error("bad split of --longoption=arg") ) else LongOption = LongOptionStr, MaybeArg = no ), OptionName = "--" ++ LongOption, ( if LongOptionPred(LongOption, Flag) then ( if map.search(OptionTable0, Flag, OptionData) then handle_long_option(OptionName, Flag, OptionData, MaybeArg, Args0, Args, OptionOps, [Option | OptionArgs0], OptionArgs, OptionTable0, Result, !OptionsSet) else Error = option_error(Flag, Option, unknown_type), Result = error(Error), OptionArgs = OptionArgs0, Args = Args0 ) else Error = unrecognized_option(OptionName), Result = error(Error), OptionArgs = OptionArgs0, Args = Args0 ) else if string.first_char(Option, '-', ShortOptions), ShortOptions \= "" then string.to_char_list(ShortOptions, ShortOptionsList), % Process a single negated option `-x-'. ( if ShortOptionsList = [SingleShortOpt, '-'] then ShortOptionPred = OptionOps ^ short_option, ( if ShortOptionPred(SingleShortOpt, Flag) then string.from_char_list(['-', SingleShortOpt], OptName), process_negated_option(OptName, Flag, OptionOps, OptionTable0, Result1, !OptionsSet), ( Result1 = ok(OptionTable1), process_arguments(Args0, Args, OptionOps, [Option | OptionArgs0], OptionArgs, OptionTable1, Result, !OptionsSet) ; Result1 = error(_), Result = Result1, OptionArgs = OptionArgs0, Args = Args0 ) else Error = unrecognized_option("-" ++ ShortOptions), Result = error(Error), OptionArgs = OptionArgs0, Args = Args0 ) else % Process a list of options `-xyz'. % -xyz may be several boolean options % or part of it may be the argument of an option. % The first element of Args0 may also be an argument % of an option. handle_short_options(ShortOptionsList, OptionOps, Args0, Args1, [Option | OptionArgs0], OptionArgs1, OptionTable0, Result1, !OptionsSet), ( Result1 = ok(OptionTable1), process_arguments(Args1, Args, OptionOps, OptionArgs1, OptionArgs, OptionTable1, Result, !OptionsSet) ; Result1 = error(_), Result = Result1, OptionArgs = OptionArgs1, Args = Args0 ) ) else % It's a normal non-option argument. % As a GNU extension, keep searching for options % in the remaining arguments. process_arguments(Args0, Args1, OptionOps, OptionArgs0, OptionArgs, OptionTable0, Result, !OptionsSet), Args = [Option | Args1] ). :- pred handle_long_option(string::in, OptionType::in, option_data::in, maybe(string)::in, list(string)::in, list(string)::out, option_ops_internal(OptionType)::in(option_ops_internal), list(string)::in, list(string)::out, option_table(OptionType)::in, maybe_option_table_se(OptionType)::out, set(OptionType)::in, set(OptionType)::out) is det. handle_long_option(Option, Flag, OptionData, MaybeOptionArg0, Args0, Args, OptionOps, OptionArgs0, OptionArgs, OptionTable0, Result, !OptionsSet) :- ( if need_arg(OptionData, yes), MaybeOptionArg0 = no then ( Args0 = [Arg | ArgsTail], MaybeOptionArg = yes(Arg), Args1 = ArgsTail, MissingArg = no, OptionArgs1 = [Arg | OptionArgs0] ; Args0 = [], MaybeOptionArg = no, Args1 = Args0, OptionArgs1 = OptionArgs0, MissingArg = yes ) else MaybeOptionArg = MaybeOptionArg0, Args1 = Args0, OptionArgs1 = OptionArgs0, MissingArg = no ), ( MissingArg = yes, Args = Args0, OptionArgs = OptionArgs1, Error = option_error(Flag, Option, requires_argument), Result = error(Error) ; MissingArg = no, ( if need_arg(OptionData, no), MaybeOptionArg = yes(ArgVal) then Args = Args0, OptionArgs = OptionArgs1, Error = option_error(Flag, Option, does_not_allow_argument(ArgVal)), Result = error(Error) else process_option(OptionData, Option, Flag, MaybeOptionArg, OptionOps, OptionTable0, Result1, !OptionsSet), ( Result1 = ok(OptionTable1), process_arguments(Args1, Args, OptionOps, OptionArgs1, OptionArgs, OptionTable1, Result, !OptionsSet) ; Result1 = error(_), Result = Result1, OptionArgs = OptionArgs1, Args = Args1 ) ) ). :- pred handle_short_options(list(char)::in, option_ops_internal(OptionType)::in(option_ops_internal), list(string)::in, list(string)::out, list(string)::in, list(string)::out, option_table(OptionType)::in, maybe_option_table_se(OptionType)::out, set(OptionType)::in, set(OptionType)::out) is det. handle_short_options([], _, Args, Args, OptionArgs, OptionArgs, OptionTable, ok(OptionTable), !OptionsSet). handle_short_options([Opt | Opts0], OptionOps, Args0, Args, OptionArgs0, OptionArgs, OptionTable0, Result, !OptionsSet) :- ShortOptionPred = OptionOps ^ short_option, ( if ShortOptionPred(Opt, Flag) then ( if map.search(OptionTable0, Flag, OptionData) then ( if need_arg(OptionData, yes) then get_short_option_arg(Opts0, Arg, Args0, Args1, OptionArgs0, OptionArgs1), MaybeOptionArg = yes(Arg), Opts1 = [] else MaybeOptionArg = no, Opts1 = Opts0, OptionArgs1 = OptionArgs0, Args1 = Args0 ), string.from_char_list(['-', Opt], Option), process_option(OptionData, Option, Flag, MaybeOptionArg, OptionOps, OptionTable0, Result1, !OptionsSet), ( Result1 = ok(OptionTable1), handle_short_options(Opts1, OptionOps, Args1, Args, OptionArgs1, OptionArgs, OptionTable1, Result, !OptionsSet) ; Result1 = error(_), Result = Result1, OptionArgs = OptionArgs1, Args = Args1 ) else string.char_to_string(Opt, OptString), Error = option_error(Flag, "-" ++ OptString, unknown_type), Result = error(Error), OptionArgs = OptionArgs0, Args = Args0 ) else string.char_to_string(Opt, OptString), Error = unrecognized_option("-" ++ OptString), Result = error(Error), OptionArgs = OptionArgs0, Args = Args0 ). :- pred get_short_option_arg(list(char)::in, string::out, list(string)::in, list(string)::out, list(string)::in, list(string)::out) is det. get_short_option_arg(Opts, Arg, Args0, Args, OptionArgs0, OptionArgs) :- ( if Opts = [], Args0 = [ArgPrime | ArgsPrime] then OptionArgs = [ArgPrime | OptionArgs0], Arg = ArgPrime, Args = ArgsPrime else string.from_char_list(Opts, Arg), OptionArgs = OptionArgs0, Args = Args0 ). :- pred process_option(option_data::in, string::in, OptionType::in, maybe(string)::in, option_ops_internal(OptionType)::in(option_ops_internal), option_table(OptionType)::in, maybe_option_table_se(OptionType)::out, set(OptionType)::in, set(OptionType)::out) is det. process_option(bool(_), _Option, Flag, MaybeArg, _OptionOps, OptionTable0, Result, !OptionsSet) :- set.insert(Flag, !OptionsSet), ( MaybeArg = yes(_Arg), map.set(Flag, bool(no), OptionTable0, OptionTable), Result = ok(OptionTable) ; MaybeArg = no, map.set(Flag, bool(yes), OptionTable0, OptionTable), Result = ok(OptionTable) ). process_option(int(_), Option, Flag, MaybeArg, _OptionOps, !.OptionTable, Result, !OptionsSet) :- set.insert(Flag, !OptionsSet), ( MaybeArg = yes(Arg), ( if string.to_int(Arg, IntArg) then map.set(Flag, int(IntArg), !OptionTable), Result = ok(!.OptionTable) else numeric_argument(Flag, Option, Arg, Result) ) ; MaybeArg = no, error("integer argument expected in getopt.process_option") ). process_option(string(_), _Option, Flag, MaybeArg, _OptionOps, !.OptionTable, Result, !OptionsSet) :- set.insert(Flag, !OptionsSet), ( MaybeArg = yes(Arg), map.set(Flag, string(Arg), !OptionTable), Result = ok(!.OptionTable) ; MaybeArg = no, error("string argument expected in getopt.process_option") ). process_option(maybe_int(_), Option, Flag, MaybeArg, _OptionOps, !.OptionTable, Result, !OptionsSet) :- set.insert(Flag, !OptionsSet), ( MaybeArg = yes(Arg), ( if string.to_int(Arg, IntArg) then map.set(Flag, maybe_int(yes(IntArg)), !OptionTable), Result = ok(!.OptionTable) else numeric_argument(Flag, Option, Arg, Result) ) ; MaybeArg = no, error("integer argument expected in getopt.process_option") ). process_option(maybe_string(_), _Option, Flag, MaybeArg, _OptionOps, !.OptionTable, Result, !OptionsSet) :- set.insert(Flag, !OptionsSet), ( MaybeArg = yes(Arg), map.set(Flag, maybe_string(yes(Arg)), !OptionTable), Result = ok(!.OptionTable) ; MaybeArg = no, error("string argument expected in getopt.process_option") ). process_option(accumulating(List0), _Option, Flag, MaybeArg, _OptionOps, !.OptionTable, Result, !OptionsSet) :- set.insert(Flag, !OptionsSet), ( MaybeArg = yes(Arg), list.append(List0, [Arg], List), map.set(Flag, accumulating(List), !OptionTable), Result = ok(!.OptionTable) ; MaybeArg = no, error("acumulating argument expected in getopt.process_option") ). process_option(special, Option, Flag, MaybeArg, OptionOps, OptionTable0, Result, !OptionsSet) :- set.insert(Flag, !OptionsSet), ( MaybeArg = yes(_Arg), error("no special argument expected in getopt.process_option") ; MaybeArg = no, process_special(Option, Flag, none, OptionOps, OptionTable0, Result, !OptionsSet) ). process_option(bool_special, Option, Flag, MaybeArg, OptionOps, OptionTable0, Result, !OptionsSet) :- set.insert(Flag, !OptionsSet), ( MaybeArg = yes(_Arg), process_special(Option, Flag, bool(no), OptionOps, OptionTable0, Result, !OptionsSet) ; MaybeArg = no, process_special(Option, Flag, bool(yes), OptionOps, OptionTable0, Result, !OptionsSet) ). process_option(int_special, Option, Flag, MaybeArg, OptionOps, OptionTable0, Result, !OptionsSet) :- set.insert(Flag, !OptionsSet), ( MaybeArg = yes(Arg), ( if string.to_int(Arg, IntArg) then process_special(Option, Flag, int(IntArg), OptionOps, OptionTable0, Result, !OptionsSet) else numeric_argument(Flag, Option, Arg, Result) ) ; MaybeArg = no, error("int_special argument expected in getopt.process_option") ). process_option(string_special, Option, Flag, MaybeArg, OptionOps, OptionTable0, Result, !OptionsSet) :- set.insert(Flag, !OptionsSet), ( MaybeArg = yes(Arg), process_special(Option, Flag, string(Arg), OptionOps, OptionTable0, Result, !OptionsSet) ; MaybeArg = no, error("string_special argument expected in getopt.process_option") ). process_option(maybe_string_special, Option, Flag, MaybeArg, OptionOps, OptionTable0, Result, !OptionsSet) :- ( MaybeArg = yes(_Arg), process_special(Option, Flag, maybe_string(MaybeArg), OptionOps, OptionTable0, Result, !OptionsSet) ; MaybeArg = no, error("maybe_string_special argument expected " ++ "in getopt.process_option") ). :- pred process_negated_option(string::in, OptionType::in, option_ops_internal(OptionType)::in(option_ops_internal), option_table(OptionType)::in, maybe_option_table_se(OptionType)::out, set(OptionType)::in, set(OptionType)::out) is det. process_negated_option(Option, Flag, OptionOps, OptionTable0, Result, !OptionsSet) :- ( if map.search(OptionTable0, Flag, OptionData) then ( OptionData = bool(_), set.insert(Flag, !OptionsSet), map.set(Flag, bool(no), OptionTable0, OptionTable), Result = ok(OptionTable) ; OptionData = maybe_int(_), set.insert(Flag, !OptionsSet), map.set(Flag, maybe_int(no), OptionTable0, OptionTable), Result = ok(OptionTable) ; OptionData = maybe_string(_), set.insert(Flag, !OptionsSet), map.set(Flag, maybe_string(no), OptionTable0, OptionTable), Result = ok(OptionTable) ; OptionData = accumulating(_), set.insert(Flag, !OptionsSet), map.set(Flag, accumulating([]), OptionTable0, OptionTable), Result = ok(OptionTable) ; OptionData = bool_special, set.insert(Flag, !OptionsSet), process_special(Option, Flag, bool(no), OptionOps, OptionTable0, Result, !OptionsSet) ; OptionData = maybe_string_special, set.insert(Flag, !OptionsSet), process_special(Option, Flag, maybe_string(no), OptionOps, OptionTable0, Result, !OptionsSet) ; ( OptionData = int_special ; OptionData = string_special ; OptionData = int(_) ; OptionData = string(_) ; OptionData = special ), Error = option_error(Flag, Option, cannot_negate), Result = error(Error) ) else Error = option_error(Flag, Option, unknown_type), Result = error(Error) ). :- pred process_special(string::in, OptionType::in, special_data::in, option_ops_internal(OptionType)::in(option_ops_internal), option_table(OptionType)::in, maybe_option_table_se(OptionType)::out, set(OptionType)::in, set(OptionType)::out) is det. process_special(Option, Flag, OptionData, OptionOps, OptionTable0, Result, !OptionsSet) :- MaybeHandler = OptionOps ^ special_handler, ( MaybeHandler = notrack(Handler), ( if Handler(Flag, OptionData, OptionTable0, Result0) then ( Result0 = ok(OptionTable), Result = ok(OptionTable) ; Result0 = error(HandlerMsg), Reason = special_handler_error(HandlerMsg), Error = option_error(Flag, Option, Reason), Result = error(Error) ) else Error = option_error(Flag, Option, special_handler_failed), Result = error(Error) ) ; MaybeHandler = track(TrackHandler), ( if TrackHandler(Flag, OptionData, OptionTable0, Result0, NewOptionsSet) then set.union(NewOptionsSet, !OptionsSet), ( Result0 = ok(OptionTable), Result = ok(OptionTable) ; Result0 = error(TrackHandlerMsg), Reason = special_handler_error(TrackHandlerMsg), Error = option_error(Flag, Option, Reason), Result = error(Error) ) else Error = option_error(Flag, Option, special_handler_failed), Result = error(Error) ) ; MaybeHandler = none, Error = option_error(Flag, Option, special_handler_missing), Result = error(Error) ). %---------------------------------------------------------------------------% :- pred need_arg(option_data::in, bool::out) is det. need_arg(bool(_), no). need_arg(int(_), yes). need_arg(string(_), yes). need_arg(maybe_int(_), yes). need_arg(maybe_string(_), yes). need_arg(accumulating(_), yes). need_arg(special, no). need_arg(bool_special, no). need_arg(int_special, yes). need_arg(string_special, yes). need_arg(maybe_string_special, yes). :- pred numeric_argument(OptionType::in, string::in, string::in, maybe_option_table_se(OptionType)::out) is det. numeric_argument(Flag, Option, Arg, Result) :- Reason = requires_numeric_argument(Arg), Error = option_error(Flag, Option, Reason), Result = error(Error). %---------------------------------------------------------------------------% option_error_to_string(Error) = String :- ( Error = unrecognized_option(OptionName), string.format("unrecognized option `%s'", [s(OptionName)], String) ; Error = option_error(_, OptionName, Reason), ( Reason = unknown_type, string.format("unknown type for option `%s'", [s(OptionName)], String) ; Reason = requires_argument, string.format("option `%s' needs an argument", [s(OptionName)], String) ; Reason = does_not_allow_argument(_), string.format("option `%s' does not allow an argument", [s(OptionName)], String) ; Reason = cannot_negate, string.format("cannot negate option `%s' -- " ++ "only boolean, maybe and accumulating options can be negated", [s(OptionName)], String) ; Reason = special_handler_failed, string.format("the handler of option `%s' failed", [s(OptionName)], String) ; Reason = special_handler_missing, string.format("option `%s' has no handler", [s(OptionName)], String) ; Reason = special_handler_error(String) ; Reason = requires_numeric_argument(Arg), string.format( "option `%s' requires a numeric argument; `%s' is not numeric", [s(OptionName), s(Arg)], String) ) ). %---------------------------------------------------------------------------% lookup_bool_option(OT, Opt) = B :- lookup_bool_option(OT, Opt, B). lookup_bool_option(OptionTable, Opt, Val) :- ( if map.lookup(OptionTable, Opt, bool(Val0)) then Val = Val0 else error("Expected bool option and didn't get one.") ). lookup_int_option(OT, Opt) = N :- lookup_int_option(OT, Opt, N). lookup_int_option(OptionTable, Opt, Val) :- ( if map.lookup(OptionTable, Opt, int(Val0)) then Val = Val0 else error("Expected int option and didn't get one.") ). lookup_string_option(OT, Opt) = S :- lookup_string_option(OT, Opt, S). lookup_string_option(OptionTable, Opt, Val) :- ( if map.lookup(OptionTable, Opt, string(Val0)) then Val = Val0 else error("Expected string option and didn't get one.") ). lookup_maybe_int_option(OT, Opt) = MN :- lookup_maybe_int_option(OT, Opt, MN). lookup_maybe_int_option(OptionTable, Opt, Val) :- ( if map.lookup(OptionTable, Opt, maybe_int(Val0)) then Val = Val0 else error("Expected maybe_int option and didn't get one.") ). lookup_maybe_string_option(OT, Opt) = MS :- lookup_maybe_string_option(OT, Opt, MS). lookup_maybe_string_option(OptionTable, Opt, Val) :- ( if map.lookup(OptionTable, Opt, maybe_string(Val0)) then Val = Val0 else error("Expected maybe_string option and didn't get one.") ). lookup_accumulating_option(OT, Opt) = Ss :- lookup_accumulating_option(OT, Opt, Ss). lookup_accumulating_option(OptionTable, Opt, Val) :- ( if map.lookup(OptionTable, Opt, accumulating(Val0)) then Val = Val0 else error("Expected accumulating option and didn't get one.") ). %---------------------------------------------------------------------------% :- end_module getopt. %---------------------------------------------------------------------------%