From c852e707151f069979a0bccb7cd09e3138cf7d6c Mon Sep 17 00:00:00 2001 From: Fergus Henderson Date: Thu, 3 Mar 1994 05:36:17 +0000 Subject: [PATCH] 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.) --- compiler/getopt.m | 210 ++++++++++++++++++++++++++++++++++++++++++++ compiler/globals.m | 35 ++++++++ compiler/hlds_out.m | 2 +- compiler/options.m | 40 +++++++++ library/string.m | 15 ++++ 5 files changed, 301 insertions(+), 1 deletion(-) create mode 100644 compiler/getopt.m create mode 100644 compiler/globals.m create mode 100644 compiler/options.m diff --git a/compiler/getopt.m b/compiler/getopt.m new file mode 100644 index 000000000..efb4436e0 --- /dev/null +++ b/compiler/getopt.m @@ -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. + +%-----------------------------------------------------------------------------% diff --git a/compiler/globals.m b/compiler/globals.m new file mode 100644 index 000000000..9b0068341 --- /dev/null +++ b/compiler/globals.m @@ -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). + +%-----------------------------------------------------------------------------% diff --git a/compiler/hlds_out.m b/compiler/hlds_out.m index 2b39d6c68..5dbe5f265 100644 --- a/compiler/hlds_out.m +++ b/compiler/hlds_out.m @@ -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 }, diff --git a/compiler/options.m b/compiler/options.m new file mode 100644 index 000000000..a351c2d93 --- /dev/null +++ b/compiler/options.m @@ -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. + +%-----------------------------------------------------------------------------% diff --git a/library/string.m b/library/string.m index ce7ec887b..faa2a1870 100644 --- a/library/string.m +++ b/library/string.m @@ -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),