mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-18 15:26:31 +00:00
Add command-line option handling.
(Command-line options are now parsed, and the option data is saved in the io__state, but the options aren't yet actually used.)
This commit is contained in:
Fergus Henderson
210
compiler/getopt.m
Normal file
210
compiler/getopt.m
Normal file
@@ -0,0 +1,210 @@
|
||||
%-----------------------------------------------------------------------------%
|
||||
|
||||
:- module getopt.
|
||||
:- interface.
|
||||
:- import_module options, map, list, string.
|
||||
|
||||
% process_options(Args, NonOptionArgs, Result)
|
||||
%
|
||||
% Scans through 'Args' looking for options, places all the
|
||||
% non-option arguments in 'NonOptionArgs', and record the
|
||||
% options in the OptionTable.
|
||||
% If an invalid option is encountered, we return error(Message)
|
||||
% otherwise we return ok(OptionTable) in Result.
|
||||
% OptionTable is a map from option to option_data.
|
||||
%
|
||||
% 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.
|
||||
% Options are recognized using the short_option/3 and
|
||||
% long_option/3 predicate provided in options.nl.
|
||||
%
|
||||
% TODO: check POSIX conformance.
|
||||
|
||||
:- type option_table == map(option, option_data).
|
||||
|
||||
:- type maybe_option_table ---> ok(option_table)
|
||||
; error(string).
|
||||
|
||||
:- pred process_options(list(string)::i, list(string)::o,
|
||||
maybe_option_table::o) is det.
|
||||
|
||||
:- implementation.
|
||||
|
||||
process_options(Args0, Args, Result) :-
|
||||
option_defaults(OptionDefaultsList),
|
||||
map__from_assoc_list(OptionDefaultsList, OptionTable0),
|
||||
process_options_2(Args0, OptionTable0, Args, Result).
|
||||
|
||||
:- pred process_options_2(list(string)::i, option_table::i,
|
||||
list(string)::o, maybe_option_table::o) is det.
|
||||
|
||||
process_options_2([], OptionTable, [], ok(OptionTable)).
|
||||
process_options_2([Option | Args0], OptionTable0, Args, Result) :-
|
||||
( Option = "--" -> % "--" terminates option processing
|
||||
Args = Args0,
|
||||
Result = ok(OptionTable0)
|
||||
; string__append("--no-", LongOption, Option) ->
|
||||
( long_option(LongOption, Flag) ->
|
||||
process_negated_bool_option(Flag, Args0, OptionTable0,
|
||||
Args, Result)
|
||||
;
|
||||
string__append("unrecognized option `--no-",
|
||||
LongOption, Tmp),
|
||||
string__append(Tmp, "'", ErrorMsg),
|
||||
Result = error(ErrorMsg),
|
||||
Args = Args0
|
||||
)
|
||||
; string__append("--", LongOption, Option) ->
|
||||
( long_option(LongOption, Flag) ->
|
||||
process_option(Flag, Args0, OptionTable0,
|
||||
Args, Result)
|
||||
;
|
||||
string__append("unrecognized option `--", LongOption,
|
||||
Tmp),
|
||||
string__append(Tmp, "'", ErrorMsg),
|
||||
Result = error(ErrorMsg),
|
||||
Args = Args0
|
||||
)
|
||||
; string__first_char(Option, '-', ShortOptions) ->
|
||||
string__to_char_list(ShortOptions, ShortOptionsList),
|
||||
% check for a single `-x' option
|
||||
( ShortOptionsList = [SingleShortOpt] ->
|
||||
( short_option(SingleShortOpt, Flag) ->
|
||||
process_option(Flag, Args0, OptionTable0,
|
||||
Args, Result)
|
||||
;
|
||||
string__append("unrecognized option `-",
|
||||
ShortOptions, Tmp),
|
||||
string__append(Tmp, "'", ErrorMsg),
|
||||
Result = error(ErrorMsg),
|
||||
Args = Args0
|
||||
)
|
||||
% check for a single negated option `-x-'
|
||||
; ShortOptionsList = [SingleShortOpt, '-'] ->
|
||||
( short_option(SingleShortOpt, Flag) ->
|
||||
process_negated_bool_option(Flag, Args0,
|
||||
OptionTable0, Args, Result)
|
||||
;
|
||||
string__append("unrecognized option `-",
|
||||
ShortOptions, Tmp),
|
||||
string__append(Tmp, "'", ErrorMsg),
|
||||
Result = error(ErrorMsg),
|
||||
Args = Args0
|
||||
)
|
||||
;
|
||||
% process a list of boolean options `-xyz'
|
||||
process_short_option_list(ShortOptionsList, Args0,
|
||||
OptionTable0, Args, Result)
|
||||
)
|
||||
;
|
||||
% It's a normal non-option argument.
|
||||
% As a GNU extension, keep searching for options
|
||||
% in the remaining arguments.
|
||||
Args = [Option | Args1],
|
||||
process_options_2(Args0, OptionTable0, Args1, Result)
|
||||
).
|
||||
|
||||
:- pred process_short_option_list(list(character), list(string), option_table,
|
||||
list(string), maybe_option_table).
|
||||
|
||||
process_short_option_list([], Args0, OptionsTable0, Args, Result) :-
|
||||
process_options_2(Args0, OptionsTable0, Args, Result).
|
||||
|
||||
process_short_option_list([Opt | Opts], Args0, OptionsTable0, Args, Result) :-
|
||||
( short_option(Opt, Flag) ->
|
||||
process_short_option(Flag, Opts, Args0, OptionsTable0,
|
||||
Args, Result)
|
||||
;
|
||||
string__char_to_string(Opt, OptString),
|
||||
string__append("unrecognized option `-", OptString, Tmp),
|
||||
string__append(Tmp, "'", ErrorMessage),
|
||||
Result = error(ErrorMessage),
|
||||
Args = Args0
|
||||
).
|
||||
|
||||
:- pred process_short_option(option, list(character), list(string),
|
||||
option_table, list(string), maybe_option_table).
|
||||
:- mode process_short_option(input, input, input, input, output, output).
|
||||
|
||||
process_short_option(Flag, Opts, Args0, OptionTable0, Args, Result) :-
|
||||
map__search(OptionTable0, Flag, Data),
|
||||
process_short_option_2(Data, Flag, Opts, Args0, OptionTable0,
|
||||
Args, Result).
|
||||
|
||||
:- pred process_short_option_2(option_data, option, list(character),
|
||||
list(string), option_table, list(string), maybe_option_table).
|
||||
:- mode process_short_option_2(input, input, input, input, input,
|
||||
output, output).
|
||||
|
||||
process_short_option_2(bool(_), Flag, Opts, Args0, OptionTable0, Args,
|
||||
Result) :-
|
||||
map__set(OptionTable0, Flag, bool(yes), OptionTable1),
|
||||
process_short_option_list(Opts, Args0, OptionTable1, Args, Result).
|
||||
process_short_option_2(string(_), _Flag, _Opts, Args, _OptionTable0, Args,
|
||||
Result) :-
|
||||
% XXX improve error message
|
||||
Result = error("option in group requires an argument").
|
||||
process_short_option_2(int(_), _Flag, _Opts, Args, _OptionTable0, Args,
|
||||
Result) :-
|
||||
% XXX improve error message
|
||||
Result = error("option in group requires an argument").
|
||||
|
||||
:- pred process_option(option, list(string), option_table,
|
||||
list(string), maybe_option_table).
|
||||
:- mode process_option(input, input, input, output, output).
|
||||
|
||||
process_option(Flag, Args0, OptionTable0, Args, Result) :-
|
||||
map__search(OptionTable0, Flag, Data),
|
||||
process_option_2(Data, Flag, Args0, OptionTable0, Args, Result).
|
||||
|
||||
:- pred process_option_2(option_data, option, list(string), option_table,
|
||||
list(string), maybe_option_table).
|
||||
:- mode process_option_2(input, input, input, input, output, output).
|
||||
|
||||
process_option_2(bool(_), Flag, Args0, OptionTable0, Args, Result) :-
|
||||
map__set(OptionTable0, Flag, bool(yes), OptionTable1),
|
||||
process_options_2(Args0, OptionTable1, Args, Result).
|
||||
process_option_2(string(_), Flag, Args0, OptionTable0, Args, Result) :-
|
||||
( Args0 = [Arg | Args1] ->
|
||||
map__set(OptionTable0, Flag, string(Arg), OptionTable1),
|
||||
process_options_2(Args1, OptionTable1, Args, Result)
|
||||
;
|
||||
Args = Args0,
|
||||
Result = error("option requires an argument")
|
||||
).
|
||||
process_option_2(int(_), Flag, Args0, OptionTable0, Args, Result) :-
|
||||
( Args0 = [Arg | Args1] ->
|
||||
( string__to_int(Arg, IntArg) ->
|
||||
map__set(OptionTable0, Flag, int(IntArg), OptionTable1),
|
||||
process_options_2(Args1, OptionTable1, Args, Result)
|
||||
;
|
||||
Args = Args0,
|
||||
% XXX improve error message
|
||||
Result = error("option requires numeric argument")
|
||||
)
|
||||
;
|
||||
Args = Args0,
|
||||
% XXX improve error message
|
||||
Result = error("option requires an argument")
|
||||
).
|
||||
|
||||
:- pred process_negated_bool_option(option, list(string), option_table,
|
||||
list(string), maybe_option_table).
|
||||
:- mode process_negated_bool_option(input, input, input, output, output).
|
||||
|
||||
process_negated_bool_option(Flag, Args0, OptionTable0, Args, Result) :-
|
||||
map__search(OptionTable0, Flag, Data),
|
||||
( Data = bool(_) ->
|
||||
map__set(OptionTable0, Flag, bool(no), OptionTable1),
|
||||
process_options_2(Args0, OptionTable1, Args, Result)
|
||||
;
|
||||
Args = Args0,
|
||||
% XXX improve error message
|
||||
Result = error("only boolean options can be negated")
|
||||
).
|
||||
|
||||
:- end_module getopt.
|
||||
|
||||
%-----------------------------------------------------------------------------%
|
||||
35
compiler/globals.m
Normal file
35
compiler/globals.m
Normal file
@@ -0,0 +1,35 @@
|
||||
%-----------------------------------------------------------------------------%
|
||||
|
||||
:- module globals.
|
||||
|
||||
% Main author: fjh.
|
||||
|
||||
% This module exports the `globals' type and associated access predicates.
|
||||
% The globals type is used to collect together all the various data
|
||||
% that would be global variables in an imperative language.
|
||||
% This global data is stored in the io__state.
|
||||
|
||||
%-----------------------------------------------------------------------------%
|
||||
|
||||
:- interface.
|
||||
:- import_module options.
|
||||
|
||||
:- type globals.
|
||||
|
||||
:- pred globals__init(option_table::in, globals::out).
|
||||
|
||||
:- pred globals__get_options(globals::in, option_table::out).
|
||||
|
||||
%-----------------------------------------------------------------------------%
|
||||
|
||||
:- implementation.
|
||||
|
||||
% currently the only global data is the option table
|
||||
|
||||
:- type globals == option_table.
|
||||
|
||||
globals__init(Globals, Globals).
|
||||
|
||||
globals__get_options(Globals, Globals).
|
||||
|
||||
%-----------------------------------------------------------------------------%
|
||||
@@ -320,7 +320,7 @@ hlds_out__write_goal(Indent, switch(VarId, Cases, FollowVars)) -->
|
||||
hlds_out__write_followvars(Indent1, FollowVars),
|
||||
hlds_out__write_indent(Indent),
|
||||
io__write_string(")\n").
|
||||
hlds_out__write_goal(Indent, unify(LTerm, RTerm, Mode, Uni)) -->
|
||||
hlds_out__write_goal(Indent, unify(LTerm, RTerm, Mode, Uni, _)) -->
|
||||
hlds_out__write_indent(Indent),
|
||||
io__write_string("unify(\n"),
|
||||
{ Indent1 is Indent + 1 },
|
||||
|
||||
40
compiler/options.m
Normal file
40
compiler/options.m
Normal file
@@ -0,0 +1,40 @@
|
||||
%-----------------------------------------------------------------------------%
|
||||
|
||||
% Define the stuff necessary so that getopt.nl
|
||||
% can parse the command-line options.
|
||||
% When we implement higher-order preds, this and
|
||||
% getopt.nl should be rewritten to use them.
|
||||
% Currently the interface dependencies are very hairy.
|
||||
|
||||
:- module options.
|
||||
:- interface.
|
||||
:- import_module int, string, std_util, list, io.
|
||||
|
||||
:- type option_data ---> bool(bool)
|
||||
; int(int) % not yet implemented
|
||||
; string(string) % not yet implemented
|
||||
; accumulating(list(string)). % not yet imp.
|
||||
|
||||
:- type option ---> verbose
|
||||
; very_verbose.
|
||||
|
||||
:- pred short_option(character::i, option::output) is semidet.
|
||||
:- pred long_option(string::i, option::output) is semidet.
|
||||
:- pred option_defaults(list(pair(option, option_data))::output) is det.
|
||||
|
||||
:- implementation.
|
||||
|
||||
option_defaults([
|
||||
verbose - bool(no),
|
||||
very_verbose - bool(no)
|
||||
]).
|
||||
|
||||
short_option('v', verbose).
|
||||
short_option('w', very_verbose).
|
||||
|
||||
long_option("verbose", verbose).
|
||||
long_option("very-verbose", very_verbose).
|
||||
|
||||
:- end_module options.
|
||||
|
||||
%-----------------------------------------------------------------------------%
|
||||
@@ -50,6 +50,10 @@
|
||||
:- mode string__uncapitalize_first(input, output).
|
||||
% Convert the first character (if any) of a string to lowercase.
|
||||
|
||||
:- pred string__to_char_list(string, list(character)).
|
||||
:- mode string__to_char_list(input, output).
|
||||
:- mode string__to_char_list(output, input).
|
||||
|
||||
:- pred string__to_int(string, int).
|
||||
:- mode string__to_int(input, output).
|
||||
% Convert a string (of digits) to an int. If the string contains
|
||||
@@ -123,6 +127,17 @@ string__first_char(String0, Char, String) :-
|
||||
string__to_int_list(String, List),
|
||||
char_to_int(Char, CharCode).
|
||||
|
||||
string__to_char_list(String, CharList) :-
|
||||
string__to_int_list(String, IntList),
|
||||
string__int_list_to_char_list(IntList, CharList).
|
||||
|
||||
:- pred string__int_list_to_char_list(list(int)::in, list(character)::out).
|
||||
|
||||
string__int_list_to_char_list([], []).
|
||||
string__int_list_to_char_list([Code | Codes], [Char | Chars]) :-
|
||||
char_to_int(Char, Code),
|
||||
string__int_list_to_char_list(Codes, Chars).
|
||||
|
||||
string__capitalize_first(S0, S) :-
|
||||
string__first_char(S0, C, S1),
|
||||
to_upper(C, UpperC),
|
||||
|
||||
Reference in New Issue
Block a user