[m-rev.] for review: library improvements
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Dec 16 11:55:36 AEDT 2004
A bunch of small improvements to the library.
library/getopt.m:
Allow the determinism of the the option_defaults predicate
passed by users to getopt__process_options to be multi as well as
nondet. The natural determinism of such predicates is multi;
the nondet determinism dates from before the time the compiler
supported multi.
Add a version of process_options that allows it to be run more
than once (by allowing it to start with an option table returned
by a previous invocation) and returns the set of options set by
each invocation, so that the caller can tell which invocation
(if any) has set any given option.
Switch to 4-space indentation to reduce the number of bad line breaks.
library/svset.m:
This new module svset makes it easier to work with sets in
code that uses state variables. For every predicate in set.m that
updates sets, svset.m contains a predicate doing the same thing
with an argument order conducive to the use of state variables.
This module is now used in getopt.m.
library/library.m:
Mention the new module.
library/map.m:
library/tree234.m:
Add new module to map__map_foldl that I found I needed in elk.
library/map.m:
library/svmap.m:
Apply type specialization to all the most frequently used predicates
for updating maps.
NEWS:
Mention the functionality in getopt.m, and the new module.
Group all the items related to getopt.m.
browser/parse.m:
compiler/options.m:
profiler/mercury_profile.m:
deep_profiler/mdprof_cgi.m:
deep_profiler/mdprof_test.m:
Conform to the new determinism in getopt.m.
Zoltan.
cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.354
diff -u -r1.354 NEWS
--- NEWS 15 Dec 2004 06:57:18 -0000 1.354
+++ NEWS 15 Dec 2004 12:24:20 -0000
@@ -21,8 +21,9 @@
version_array2d, version_bitmap, version_hash_table, and version_store,
implementing non-unique versions of these types supporting O(1) access for
non-persistent use. A new module term_to_xml has been added for converting
- arbitrary terms to XML documents. A new module svmap now provides a more
- convenient way to update maps in code that uses state variables.
+ arbitrary terms to XML documents. Two new modules, svmap and svset, now
+ provide more convenient ways to update maps and sets in code that uses
+ state variables.
* New procedures have been added to many of the existing standard library
modules. Most notably, these include procedures for creating
directories and symbolic links, for checking file types and file
@@ -237,8 +238,6 @@
* We've added a function version of `hash_table__search/3'.
-* getopt.m now accepts a `maybe_string_special' option type.
-
* We've added a predicate, copy_mutvar, to store.m.
* We've added a function, clk_tck, to time.m.
@@ -697,11 +696,17 @@
`ops__init_op_table' and `ops__max_priority'.
* We've added a version of `getopt__process_options' which returns
- the option arguments.
+ the option arguments as well as the nonoption arguments. Both versions
+ allow multi as well nondet predicates to specify the default values
+ of options.
+
+* We've added a new predicate `getopt__process_options_track', which can be
+ usefully invoked more than once to process separate sets of options.
-* `getopt__process_options' has been modified to allow negation of
+* All these predicates in getopt.m now allow the allow negation of
accumulating options. Negating an accumulating option empties
- the accumulated list of strings.
+ the accumulated list of strings. They also accept a `maybe_string_special'
+ option type.
* We've added some functions to the term_io module to return printable
representations of term components as strings.
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
Index: browser/parse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/parse.m,v
retrieving revision 1.21
diff -u -r1.21 parse.m
--- browser/parse.m 27 Oct 2004 02:23:27 -0000 1.21
+++ browser/parse.m 15 Dec 2004 11:42:53 -0000
@@ -378,9 +378,8 @@
Command = set
;
MaybeArgWords = yes(ArgWords),
- OptionOps = option_ops(short_setting_option,
- long_setting_option,
- setting_option_defaults_nondet),
+ OptionOps = option_ops_multi(short_setting_option,
+ long_setting_option, setting_option_defaults),
getopt__process_options(OptionOps, ArgWords,
RemainingWords, MaybeOptionTable),
lexer_words(RemainingWords, RemainingTokens),
@@ -418,9 +417,8 @@
RemainingTokens = ArgTokens
;
MaybeArgWords = yes(ArgWords),
- OptionOps = option_ops(short_format_option,
- long_format_option,
- format_option_defaults_nondet),
+ OptionOps = option_ops_multi(short_format_option,
+ long_format_option, format_option_defaults),
getopt__process_options(OptionOps, ArgWords,
RemainingWords, MaybeOptionTable),
MaybeMaybeOptionTable = yes(MaybeOptionTable),
@@ -438,8 +436,8 @@
->
ArgTokens = [num(Depth)],
% compute the default MaybeOptionTable
- OptionOps = option_ops(short_setting_option,
- long_setting_option, setting_option_defaults_nondet),
+ OptionOps = option_ops_multi(short_setting_option,
+ long_setting_option, setting_option_defaults),
getopt__process_options(OptionOps, [], _, MaybeOptionTable),
Command = set(MaybeOptionTable, depth(Depth))
;
@@ -536,16 +534,6 @@
long_format_option("verbose", verbose).
long_format_option("pretty", pretty).
-:- pred format_option_defaults_nondet(format_option::out, option_data::out)
- is nondet.
-
-format_option_defaults_nondet(Option, Value) :-
- ( semidet_succeed ->
- format_option_defaults(Option, Value)
- ;
- fail
- ).
-
:- pred format_option_defaults(format_option::out, option_data::out) is multi.
format_option_defaults(flat, bool(no)).
@@ -574,16 +562,6 @@
long_setting_option("raw-pretty", raw_pretty).
long_setting_option("verbose", verbose).
long_setting_option("pretty", pretty).
-
-:- pred setting_option_defaults_nondet(setting_option::out, option_data::out)
- is nondet.
-
-setting_option_defaults_nondet(Option, Value) :-
- ( semidet_succeed ->
- setting_option_defaults(Option, Value)
- ;
- fail
- ).
:- pred setting_option_defaults(setting_option::out, option_data::out)
is multi.
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.437
diff -u -r1.437 options.m
--- compiler/options.m 30 Nov 2004 06:54:32 -0000 1.437
+++ compiler/options.m 15 Dec 2004 11:42:32 -0000
@@ -721,7 +721,7 @@
:- pred option_defaults_2(option_category, list(pair(option, option_data))).
:- mode option_defaults_2(in, out) is det.
-:- mode option_defaults_2(out, out) is multidet.
+:- mode option_defaults_2(out, out) is multi.
option_defaults_2(warning_option, [
% Warning Options
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
Index: deep_profiler/mdprof_cgi.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/mdprof_cgi.m,v
retrieving revision 1.6
diff -u -r1.6 mdprof_cgi.m
--- deep_profiler/mdprof_cgi.m 12 Jan 2004 04:29:23 -0000 1.6
+++ deep_profiler/mdprof_cgi.m 15 Dec 2004 11:41:46 -0000
@@ -37,7 +37,8 @@
io__get_environment_var("QUERY_STRING", MaybeQueryString, !IO),
(
MaybeQueryString = yes(QueryString0),
- getopt__process_options(option_ops(short, long, defaults),
+ getopt__process_options(
+ option_ops_multi(short, long, defaults),
[], _, MaybeOptions),
(
MaybeOptions = ok(Options)
@@ -74,7 +75,7 @@
% io__write_string("Args0: ", !IO),
% io__write_list(Args0, " ", write_bracketed_string, !IO),
% io__nl(!IO),
- getopt__process_options(option_ops(short, long, defaults),
+ getopt__process_options(option_ops_multi(short, long, defaults),
Args0, Args, MaybeOptions),
(
MaybeOptions = ok(Options),
@@ -690,29 +691,23 @@
long("version", version).
long("write-query-string", write_query_string).
-:- pred defaults(option::out, option_data::out) is nondet.
+:- pred defaults(option::out, option_data::out) is multi.
-defaults(Option, Data) :-
- semidet_succeed,
- defaults0(Option, Data).
-
-:- pred defaults0(option::out, option_data::out) is multi.
-
-defaults0(canonical_clique, bool(no)).
-defaults0(clique, int(0)).
-defaults0(debug, bool(no)).
-defaults0(detach_process, bool(yes)).
-defaults0(help, bool(no)).
-defaults0(modules, bool(no)).
-defaults0(proc, int(0)).
-defaults0(quit, bool(no)).
-defaults0(root, bool(no)).
-defaults0(record_loop, bool(yes)).
-defaults0(record_startup, bool(yes)).
-defaults0(server_process, bool(yes)).
-defaults0(timeout, int(30)).
-defaults0(version, bool(no)).
-defaults0(write_query_string, bool(yes)).
+defaults(canonical_clique, bool(no)).
+defaults(clique, int(0)).
+defaults(debug, bool(no)).
+defaults(detach_process, bool(yes)).
+defaults(help, bool(no)).
+defaults(modules, bool(no)).
+defaults(proc, int(0)).
+defaults(quit, bool(no)).
+defaults(root, bool(no)).
+defaults(record_loop, bool(yes)).
+defaults(record_startup, bool(yes)).
+defaults(server_process, bool(yes)).
+defaults(timeout, int(30)).
+defaults(version, bool(no)).
+defaults(write_query_string, bool(yes)).
:- func default_cmd(option_table) = cmd.
Index: deep_profiler/mdprof_test.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/mdprof_test.m,v
retrieving revision 1.4
diff -u -r1.4 mdprof_test.m
--- deep_profiler/mdprof_test.m 12 Jan 2004 04:29:23 -0000 1.4
+++ deep_profiler/mdprof_test.m 15 Dec 2004 11:41:51 -0000
@@ -27,7 +27,7 @@
main(!IO) :-
io__progname_base("mdprof_test", ProgName, !IO),
io__command_line_arguments(Args0, !IO),
- getopt__process_options(option_ops(short, long, defaults),
+ getopt__process_options(option_ops_multi(short, long, defaults),
Args0, Args, MaybeOptions),
(
MaybeOptions = ok(Options),
@@ -214,18 +214,12 @@
long("test-dir", test_dir).
long("version", version).
-:- pred defaults(option::out, option_data::out) is nondet.
+:- pred defaults(option::out, option_data::out) is multi.
-defaults(Option, Data) :-
- semidet_succeed,
- defaults0(Option, Data).
-
-:- pred defaults0(option::out, option_data::out) is multi.
-
-defaults0(canonical_clique, bool(no)).
-defaults0(help, bool(no)).
-defaults0(test, bool(no)).
-defaults0(test_dir, string("deep_test")).
-defaults0(version, bool(no)).
+defaults(canonical_clique, bool(no)).
+defaults(help, bool(no)).
+defaults(test, bool(no)).
+defaults(test_dir, string("deep_test")).
+defaults(version, bool(no)).
%-----------------------------------------------------------------------------%
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/getopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/getopt.m,v
retrieving revision 1.30
diff -u -r1.30 getopt.m
--- library/getopt.m 19 Jul 2004 04:36:12 -0000 1.30
+++ library/getopt.m 15 Dec 2004 11:39:22 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
% Copyright (C) 1994-1999,2001-2004 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.
@@ -30,23 +32,23 @@
%
% 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)')
+% - 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)
+% - accumulating (which accumulates a list of strings)
%
% And the following "special" option types:
%
-% - special
-% - bool_special
-% - int_special
-% - string_special
-% - maybe_string_special
+% - special
+% - bool_special
+% - int_special
+% - string_special
+% - maybe_string_special
%
% For the "simple" option types, if there are multiple occurrences
% of the same option on the command-line, then the last (right-most)
@@ -74,611 +76,744 @@
:- module getopt.
:- interface.
-:- import_module bool, char, list, map, std_util.
+:- import_module bool, char, list, set, map, std_util.
% getopt__process_options(OptionOps, Args, NonOptionArgs, Result)
-%
% getopt__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'.
+% 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:
+% 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.
+% True if the character names a valid single-character option.
%
% :- pred long_option(string::in, option::out) is semidet.
-% True if the character names a valid long option.
+% True if the character names a valid long option.
%
-% :- pred option_default(option::out, option_data::out) is nondet.
-% Nondeterministically returns all the options with their
-% corresponding types and default values.
+% :- 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 getopt__process_options(
- option_ops(OptionType)::in(option_ops),
- list(string)::in,
- list(string)::out,
- maybe_option_table(OptionType)::out
- ) is det.
-
-:- pred getopt__process_options(
- option_ops(OptionType)::in(option_ops),
- list(string)::in,
- list(string)::out,
- list(string)::out,
- maybe_option_table(OptionType)::out
- ) is det.
+% 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 getopt__process_options(option_ops(OptionType)::in(option_ops),
+ list(string)::in, list(string)::out,
+ maybe_option_table(OptionType)::out) is det.
+
+:- pred getopt__process_options(option_ops(OptionType)::in(option_ops),
+ list(string)::in, list(string)::out, list(string)::out,
+ maybe_option_table(OptionType)::out) is det.
+
+% getopt__process_options_track(OptionOps, Args, OptionArgs,
+% NonOptionArgs, OptionTable0, Result, OptionsSet)
+
+:- pred getopt__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.
+
+:- 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(
+ 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(
- 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
- )
- )).
+ 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.
-
+ ---> 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)).
+ ---> none
+ ; bool(bool)
+ ; int(int)
+ ; string(string)
+ ; maybe_string(maybe(string)).
-:- type option_table(OptionType)
- == map(OptionType, option_data).
+:- type option_table(OptionType) == map(OptionType, option_data).
:- type maybe_option_table(OptionType)
- ---> ok(option_table(OptionType))
- ; error(string).
+ ---> ok(option_table(OptionType))
+ ; error(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 getopt__lookup_bool_option(option_table(Option), Option, bool).
-:- mode getopt__lookup_bool_option(in, in, out) is det.
+ % 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 getopt__lookup_bool_option(option_table(Option)::in, Option::in,
+ bool::out) is det.
:- func getopt__lookup_bool_option(option_table(Option), Option) = bool.
-:- pred getopt__lookup_int_option(option_table(Option), Option, int).
-:- mode getopt__lookup_int_option(in, in, out) is det.
-
+:- pred getopt__lookup_int_option(option_table(Option)::in, Option::in,
+ int::out) is det.
:- func getopt__lookup_int_option(option_table(Option), Option) = int.
-:- pred getopt__lookup_string_option(option_table(Option), Option, string).
-:- mode getopt__lookup_string_option(in, in, out) is det.
-
+:- pred getopt__lookup_string_option(option_table(Option)::in, Option::in,
+ string::out) is det.
:- func getopt__lookup_string_option(option_table(Option), Option) = string.
-:- pred getopt__lookup_maybe_int_option(option_table(Option), Option,
- maybe(int)).
-:- mode getopt__lookup_maybe_int_option(in, in, out) is det.
-
+:- pred getopt__lookup_maybe_int_option(option_table(Option)::in, Option::in,
+ maybe(int)::out) is det.
:- func getopt__lookup_maybe_int_option(option_table(Option), Option) =
- maybe(int).
-
-:- pred getopt__lookup_maybe_string_option(option_table(Option), Option,
- maybe(string)).
-:- mode getopt__lookup_maybe_string_option(in, in, out) is det.
+ maybe(int).
+:- pred getopt__lookup_maybe_string_option(option_table(Option)::in,
+ Option::in, maybe(string)::out) is det.
:- func getopt__lookup_maybe_string_option(option_table(Option), Option) =
- maybe(string).
-
-:- pred getopt__lookup_accumulating_option(option_table(Option), Option,
- list(string)).
-:- mode getopt__lookup_accumulating_option(in, in, out) is det.
+ maybe(string).
+:- pred getopt__lookup_accumulating_option(option_table(Option)::in,
+ Option::in, list(string)::out) is det.
:- func getopt__lookup_accumulating_option(option_table(Option), Option) =
- list(string).
+ list(string).
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module require, string.
+:- import_module require, string, svset.
-getopt__process_options(OptionOps, Args0, Args, Result) :-
- getopt__process_options(OptionOps, Args0, _, Args, Result).
+:- 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,
+ call(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,
+ call(OptionDefaultsPred, Option, OptionData)
+ ), OptionDefaultsList),
+ map__from_assoc_list(OptionDefaultsList, OptionTable).
+
+getopt__process_options(OptionOps, Args0, NonOptionArgs, Result) :-
+ getopt__process_options(OptionOps, Args0, _OptionArgs, NonOptionArgs,
+ Result).
getopt__process_options(OptionOps, Args0, OptionArgs, NonOptionArgs, Result) :-
- getopt__get_option_defaults(OptionOps, OptionDefaultsPred),
- solutions((pred(OptionDataPair::out) is nondet :-
- OptionDataPair = Option - OptionData,
- call(OptionDefaultsPred, Option, OptionData)
- ), OptionDefaultsList),
- map__from_assoc_list(OptionDefaultsList, OptionTable0),
- getopt__process_arguments(Args0, NonOptionArgs, OptionOps,
- [], RevOptionArgs, OptionTable0, Result),
- OptionArgs = list__reverse(RevOptionArgs).
+ (
+ 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),
+ getopt__process_arguments(Args0, NonOptionArgs, Internal,
+ [], RevOptionArgs, OptionTable0, Result, set__init, _OptionsSet),
+ OptionArgs = list__reverse(RevOptionArgs).
+
+getopt__process_options_track(OptionOps, Args0, OptionArgs, NonOptionArgs,
+ OptionTable0, Result, OptionsSet) :-
+ OptionOps = option_ops_track(Short, Long, Special),
+ Internal = option_ops_internal(Short, Long, track(Special)),
+ getopt__process_arguments(Args0, NonOptionArgs, Internal,
+ [], RevOptionArgs, OptionTable0, Result, set__init, OptionsSet),
+ OptionArgs = list__reverse(RevOptionArgs).
:- pred getopt__process_arguments(list(string)::in, list(string)::out,
- option_ops(OptionType)::in(option_ops), list(string)::in,
- list(string)::out, option_table(OptionType)::in,
- maybe_option_table(OptionType)::out) is det.
+ option_ops_internal(OptionType)::in(option_ops_internal), list(string)::in,
+ list(string)::out, option_table(OptionType)::in,
+ maybe_option_table(OptionType)::out,
+ set(OptionType)::in, set(OptionType)::out) is det.
getopt__process_arguments([], [], _, OptionArgs, OptionArgs,
- OptionTable, ok(OptionTable)).
+ OptionTable, ok(OptionTable), !OptionsSet).
getopt__process_arguments([Option | Args0], Args, OptionOps,
- OptionArgs0, OptionArgs, OptionTable0, Result) :-
- ( Option = "--" -> % "--" terminates option processing
- OptionArgs = OptionArgs0,
- Args = Args0,
- Result = ok(OptionTable0)
- ; string__append("--no-", LongOption, Option) ->
- getopt__get_long_options(OptionOps, LongOptionPred),
- ( call(LongOptionPred, LongOption, Flag) ->
- string__append("--", LongOption, OptName),
- process_negated_option(OptName, Flag,
- OptionOps, OptionTable0, Result1),
- ( Result1 = ok(OptionTable1) ->
- getopt__process_arguments(Args0, Args,
- OptionOps, [Option | OptionArgs0],
- OptionArgs, OptionTable1, Result)
- ;
- Result = Result1,
- OptionArgs = OptionArgs0,
- Args = Args0
- )
- ;
- string__append_list(["unrecognized option `",
- Option, "'"], ErrorMsg),
- Result = error(ErrorMsg),
- OptionArgs = OptionArgs0,
- Args = Args0
- )
- ; string__append("--", LongOptionStr, Option) ->
- getopt__get_long_options(OptionOps, LongOptionPred),
- ( string__sub_string_search(LongOptionStr, "=", OptionLen) ->
- string__split(LongOptionStr, OptionLen,
- LongOption, EqualOptionArg),
- ( string__first_char(EqualOptionArg, '=', OptionArg) ->
- MaybeArg = yes(OptionArg)
- ;
- error("bad split of --longoption=arg")
- )
- ;
- LongOption = LongOptionStr,
- MaybeArg = no
- ),
- OptionName = "--" ++ LongOption,
- ( call(LongOptionPred, LongOption, Flag) ->
- ( map__search(OptionTable0, Flag, OptionData) ->
- getopt__handle_long_option(OptionName, Flag,
- OptionData, MaybeArg, Args0, Args,
- OptionOps, [Option | OptionArgs0],
- OptionArgs, OptionTable0, Result)
- ;
- string__append_list(["unknown type for option `",
- Option, "'"], ErrorMsg),
- Result = error(ErrorMsg),
- OptionArgs = OptionArgs0,
- Args = Args0
- )
- ;
- string__append("unrecognized option `", OptionName,
- Tmp),
- string__append(Tmp, "'", ErrorMsg),
- Result = error(ErrorMsg),
- OptionArgs = OptionArgs0,
- Args = Args0
- )
- ; string__first_char(Option, '-', ShortOptions), ShortOptions \= "" ->
- string__to_char_list(ShortOptions, ShortOptionsList),
- % Process a single negated option `-x-'.
- ( ShortOptionsList = [SingleShortOpt, '-'] ->
- getopt__get_short_options(OptionOps, ShortOptionPred),
- ( call(ShortOptionPred, SingleShortOpt, Flag) ->
- string__from_char_list(['-', SingleShortOpt],
- OptName),
- process_negated_option(OptName, Flag,
- OptionOps, OptionTable0, Result1),
- ( Result1 = ok(OptionTable1) ->
- getopt__process_arguments(Args0, Args,
- OptionOps,
- [Option | OptionArgs0],
- OptionArgs, OptionTable1,
- Result)
- ;
- Result = Result1,
- OptionArgs = OptionArgs0,
- Args = Args0
- )
- ;
- string__append_list(["unrecognized option `-",
- ShortOptions, "'"], ErrorMsg),
- Result = error(ErrorMsg),
- OptionArgs = OptionArgs0,
- Args = Args0
- )
- ;
- % 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.
- getopt__handle_short_options(ShortOptionsList,
- OptionOps, Args0, Args1,
- [Option | OptionArgs0], OptionArgs1,
- OptionTable0, Result1),
- ( Result1 = ok(OptionTable1) ->
- getopt__process_arguments(Args1, Args,
- OptionOps, OptionArgs1, OptionArgs,
- OptionTable1, Result)
- ;
- Result = Result1,
- OptionArgs = OptionArgs1,
- Args = Args0
- )
- )
- ;
- % It's a normal non-option argument.
- % As a GNU extension, keep searching for options
- % in the remaining arguments.
- getopt__process_arguments(Args0, Args1, OptionOps,
- OptionArgs0, OptionArgs, OptionTable0, Result),
- Args = [Option | Args1]
- ).
+ OptionArgs0, OptionArgs, OptionTable0, Result, !OptionsSet) :-
+ ( Option = "--" -> % "--" terminates option processing
+ OptionArgs = OptionArgs0,
+ Args = Args0,
+ Result = ok(OptionTable0)
+ ; string__append("--no-", LongOption, Option) ->
+ LongOptionPred = OptionOps ^ long_option,
+ ( call(LongOptionPred, LongOption, Flag) ->
+ string__append("--", LongOption, OptName),
+ process_negated_option(OptName, Flag, OptionOps,
+ OptionTable0, Result1, !OptionsSet),
+ ( Result1 = ok(OptionTable1) ->
+ getopt__process_arguments(Args0, Args, OptionOps,
+ [Option | OptionArgs0], OptionArgs, OptionTable1, Result,
+ !OptionsSet)
+ ;
+ Result = Result1,
+ OptionArgs = OptionArgs0,
+ Args = Args0
+ )
+ ;
+ string__append_list(["unrecognized option `", Option, "'"],
+ ErrorMsg),
+ Result = error(ErrorMsg),
+ OptionArgs = OptionArgs0,
+ Args = Args0
+ )
+ ; string__append("--", LongOptionStr, Option) ->
+ LongOptionPred = OptionOps ^ long_option,
+ ( string__sub_string_search(LongOptionStr, "=", OptionLen) ->
+ string__split(LongOptionStr, OptionLen, LongOption,
+ EqualOptionArg),
+ ( string__first_char(EqualOptionArg, '=', OptionArg) ->
+ MaybeArg = yes(OptionArg)
+ ;
+ error("bad split of --longoption=arg")
+ )
+ ;
+ LongOption = LongOptionStr,
+ MaybeArg = no
+ ),
+ OptionName = "--" ++ LongOption,
+ ( call(LongOptionPred, LongOption, Flag) ->
+ ( map__search(OptionTable0, Flag, OptionData) ->
+ getopt__handle_long_option(OptionName, Flag, OptionData,
+ MaybeArg, Args0, Args, OptionOps,
+ [Option | OptionArgs0], OptionArgs,
+ OptionTable0, Result, !OptionsSet)
+ ;
+ string__append_list(["unknown type for option `", Option, "'"],
+ ErrorMsg),
+ Result = error(ErrorMsg),
+ OptionArgs = OptionArgs0,
+ Args = Args0
+ )
+ ;
+ string__append("unrecognized option `", OptionName, Tmp),
+ string__append(Tmp, "'", ErrorMsg),
+ Result = error(ErrorMsg),
+ OptionArgs = OptionArgs0,
+ Args = Args0
+ )
+ ; string__first_char(Option, '-', ShortOptions), ShortOptions \= "" ->
+ string__to_char_list(ShortOptions, ShortOptionsList),
+ % Process a single negated option `-x-'.
+ ( ShortOptionsList = [SingleShortOpt, '-'] ->
+ ShortOptionPred = OptionOps ^ short_option,
+ ( call(ShortOptionPred, SingleShortOpt, Flag) ->
+ string__from_char_list(['-', SingleShortOpt], OptName),
+ process_negated_option(OptName, Flag, OptionOps,
+ OptionTable0, Result1, !OptionsSet),
+ ( Result1 = ok(OptionTable1) ->
+ getopt__process_arguments(Args0, Args, OptionOps,
+ [Option | OptionArgs0], OptionArgs,
+ OptionTable1, Result, !OptionsSet)
+ ;
+ Result = Result1,
+ OptionArgs = OptionArgs0,
+ Args = Args0
+ )
+ ;
+ string__append_list(["unrecognized option `-", ShortOptions,
+ "'"], ErrorMsg),
+ Result = error(ErrorMsg),
+ OptionArgs = OptionArgs0,
+ Args = Args0
+ )
+ ;
+ % 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.
+ getopt__handle_short_options(ShortOptionsList, OptionOps,
+ Args0, Args1, [Option | OptionArgs0], OptionArgs1,
+ OptionTable0, Result1, !OptionsSet),
+ ( Result1 = ok(OptionTable1) ->
+ getopt__process_arguments(Args1, Args, OptionOps,
+ OptionArgs1, OptionArgs, OptionTable1, Result, !OptionsSet)
+ ;
+ Result = Result1,
+ OptionArgs = OptionArgs1,
+ Args = Args0
+ )
+ )
+ ;
+ % It's a normal non-option argument.
+ % As a GNU extension, keep searching for options
+ % in the remaining arguments.
+ getopt__process_arguments(Args0, Args1, OptionOps,
+ OptionArgs0, OptionArgs, OptionTable0, Result, !OptionsSet),
+ Args = [Option | Args1]
+ ).
:- pred getopt__handle_long_option(string::in, OptionType::in, option_data::in,
- maybe(string)::in, list(string)::in, list(string)::out,
- option_ops(OptionType)::in(option_ops), list(string)::in,
- list(string)::out, option_table(OptionType)::in,
- maybe_option_table(OptionType)::out) is det.
+ 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(OptionType)::out,
+ set(OptionType)::in, set(OptionType)::out) is det.
getopt__handle_long_option(Option, Flag, OptionData, MaybeOptionArg0,
- Args0, Args, OptionOps, OptionArgs0, OptionArgs,
- OptionTable0, Result) :-
- (
- getopt__need_arg(OptionData, yes),
- MaybeOptionArg0 = no
- ->
- ( Args0 = [Arg | ArgsTail] ->
- MaybeOptionArg = yes(Arg),
- Args1 = ArgsTail,
- MissingArg = no,
- OptionArgs1 = [Arg | OptionArgs0]
- ;
- MaybeOptionArg = no,
- Args1 = Args0,
- OptionArgs1 = OptionArgs0,
- MissingArg = yes
- )
- ;
- MaybeOptionArg = MaybeOptionArg0,
- Args1 = Args0,
- OptionArgs1 = OptionArgs0,
- MissingArg = no
- ),
- ( MissingArg = yes ->
- Args = Args0,
- OptionArgs = OptionArgs1,
- string__append_list(["option `", Option,
- "' needs an argument"],
- ErrorMsg),
- Result = error(ErrorMsg)
- ;
- getopt__need_arg(OptionData, no),
- MaybeOptionArg = yes(_)
- ->
- Args = Args0,
- OptionArgs = OptionArgs1,
- string__append_list(["option `", Option,
- "' does not allow an argument"],
- ErrorMsg),
- Result = error(ErrorMsg)
- ;
- getopt__process_option(OptionData, Option, Flag,
- MaybeOptionArg, OptionOps, OptionTable0, Result1),
- ( Result1 = ok(OptionTable1) ->
- getopt__process_arguments(Args1, Args,
- OptionOps, OptionArgs1, OptionArgs,
- OptionTable1, Result)
- ;
- Result = Result1,
- OptionArgs = OptionArgs1,
- Args = Args1
- )
- ).
+ Args0, Args, OptionOps, OptionArgs0, OptionArgs, OptionTable0, Result,
+ !OptionsSet) :-
+ (
+ getopt__need_arg(OptionData, yes),
+ MaybeOptionArg0 = no
+ ->
+ ( Args0 = [Arg | ArgsTail] ->
+ MaybeOptionArg = yes(Arg),
+ Args1 = ArgsTail,
+ MissingArg = no,
+ OptionArgs1 = [Arg | OptionArgs0]
+ ;
+ MaybeOptionArg = no,
+ Args1 = Args0,
+ OptionArgs1 = OptionArgs0,
+ MissingArg = yes
+ )
+ ;
+ MaybeOptionArg = MaybeOptionArg0,
+ Args1 = Args0,
+ OptionArgs1 = OptionArgs0,
+ MissingArg = no
+ ),
+ ( MissingArg = yes ->
+ Args = Args0,
+ OptionArgs = OptionArgs1,
+ string__append_list(["option `", Option, "' needs an argument"],
+ ErrorMsg),
+ Result = error(ErrorMsg)
+ ;
+ getopt__need_arg(OptionData, no),
+ MaybeOptionArg = yes(_)
+ ->
+ Args = Args0,
+ OptionArgs = OptionArgs1,
+ string__append_list(["option `", Option,
+ "' does not allow an argument"], ErrorMsg),
+ Result = error(ErrorMsg)
+ ;
+ getopt__process_option(OptionData, Option, Flag, MaybeOptionArg,
+ OptionOps, OptionTable0, Result1, !OptionsSet),
+ ( Result1 = ok(OptionTable1) ->
+ getopt__process_arguments(Args1, Args, OptionOps,
+ OptionArgs1, OptionArgs, OptionTable1, Result, !OptionsSet)
+ ;
+ Result = Result1,
+ OptionArgs = OptionArgs1,
+ Args = Args1
+ )
+ ).
:- pred getopt__handle_short_options(list(char)::in,
- option_ops(OptionType)::in(option_ops), list(string)::in,
- list(string)::out, list(string)::in, list(string)::out,
- option_table(OptionType)::in,
- maybe_option_table(OptionType)::out) is det.
+ 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(OptionType)::out,
+ set(OptionType)::in, set(OptionType)::out) is det.
getopt__handle_short_options([], _, Args, Args, OptionArgs, OptionArgs,
- OptionTable, ok(OptionTable)).
+ OptionTable, ok(OptionTable), !OptionsSet).
getopt__handle_short_options([Opt | Opts0], OptionOps, Args0, Args,
- OptionArgs0, OptionArgs, OptionTable0, Result) :-
- getopt__get_short_options(OptionOps, ShortOptionPred),
- ( call(ShortOptionPred, Opt, Flag) ->
- ( map__search(OptionTable0, Flag, OptionData) ->
- ( getopt__need_arg(OptionData, yes) ->
- getopt__get_short_option_arg(Opts0, Arg,
- Args0, Args1,
- OptionArgs0, OptionArgs1),
- MaybeOptionArg = yes(Arg),
- Opts1 = []
- ;
- MaybeOptionArg = no,
- Opts1 = Opts0,
- OptionArgs1 = OptionArgs0,
- Args1 = Args0
- ),
- string__from_char_list(['-', Opt], Option),
- getopt__process_option(OptionData, Option, Flag,
- MaybeOptionArg, OptionOps,
- OptionTable0, Result1),
- ( Result1 = ok(OptionTable1) ->
- getopt__handle_short_options(Opts1, OptionOps,
- Args1, Args, OptionArgs1, OptionArgs,
- OptionTable1, Result)
- ;
- Result = Result1,
- OptionArgs = OptionArgs1,
- Args = Args1
- )
- ;
- string__char_to_string(Opt, OptString),
- string__append_list(["unknown type for option `-",
- OptString, "'"], ErrorMsg),
- Result = error(ErrorMsg),
- OptionArgs = OptionArgs0,
- Args = Args0
- )
- ;
- string__char_to_string(Opt, OptString),
- string__append_list(["unrecognized option `-", OptString, "'"],
- ErrorMsg),
- Result = error(ErrorMsg),
- OptionArgs = OptionArgs0,
- Args = Args0
- ).
-
-:- pred getopt__get_short_option_arg(list(char), string,
- list(string), list(string), list(string), list(string)).
-:- mode getopt__get_short_option_arg(in, out, in, out, in, out) is det.
+ OptionArgs0, OptionArgs, OptionTable0, Result, !OptionsSet) :-
+ ShortOptionPred = OptionOps ^ short_option,
+ ( call(ShortOptionPred, Opt, Flag) ->
+ ( map__search(OptionTable0, Flag, OptionData) ->
+ ( getopt__need_arg(OptionData, yes) ->
+ getopt__get_short_option_arg(Opts0, Arg, Args0, Args1,
+ OptionArgs0, OptionArgs1),
+ MaybeOptionArg = yes(Arg),
+ Opts1 = []
+ ;
+ MaybeOptionArg = no,
+ Opts1 = Opts0,
+ OptionArgs1 = OptionArgs0,
+ Args1 = Args0
+ ),
+ string__from_char_list(['-', Opt], Option),
+ getopt__process_option(OptionData, Option, Flag, MaybeOptionArg,
+ OptionOps, OptionTable0, Result1, !OptionsSet),
+ ( Result1 = ok(OptionTable1) ->
+ getopt__handle_short_options(Opts1, OptionOps, Args1, Args,
+ OptionArgs1, OptionArgs, OptionTable1, Result, !OptionsSet)
+ ;
+ Result = Result1,
+ OptionArgs = OptionArgs1,
+ Args = Args1
+ )
+ ;
+ string__char_to_string(Opt, OptString),
+ string__append_list(["unknown type for option `-",
+ OptString, "'"], ErrorMsg),
+ Result = error(ErrorMsg),
+ OptionArgs = OptionArgs0,
+ Args = Args0
+ )
+ ;
+ string__char_to_string(Opt, OptString),
+ string__append_list(["unrecognized option `-", OptString, "'"],
+ ErrorMsg),
+ Result = error(ErrorMsg),
+ OptionArgs = OptionArgs0,
+ Args = Args0
+ ).
+
+:- pred getopt__get_short_option_arg(list(char)::in, string::out,
+ list(string)::in, list(string)::out, list(string)::in, list(string)::out)
+ is det.
getopt__get_short_option_arg(Opts, Arg, Args0, Args,
- OptionArgs0, OptionArgs) :-
- (
- Opts = [],
- Args0 = [ArgPrime | ArgsPrime]
- ->
- OptionArgs = [ArgPrime | OptionArgs0],
- Arg = ArgPrime,
- Args = ArgsPrime
- ;
- string__from_char_list(Opts, Arg),
- OptionArgs = OptionArgs0,
- Args = Args0
- ).
+ OptionArgs0, OptionArgs) :-
+ (
+ Opts = [],
+ Args0 = [ArgPrime | ArgsPrime]
+ ->
+ OptionArgs = [ArgPrime | OptionArgs0],
+ Arg = ArgPrime,
+ Args = ArgsPrime
+ ;
+ string__from_char_list(Opts, Arg),
+ OptionArgs = OptionArgs0,
+ Args = Args0
+ ).
:- pred getopt__process_option(option_data::in, string::in, OptionType::in,
- maybe(string)::in, option_ops(OptionType)::in(option_ops),
- option_table(OptionType)::in,
- maybe_option_table(OptionType)::out) is det.
+ maybe(string)::in, option_ops_internal(OptionType)::in(option_ops_internal),
+ option_table(OptionType)::in,
+ maybe_option_table(OptionType)::out,
+ set(OptionType)::in, set(OptionType)::out) is det.
getopt__process_option(bool(_), _Option, Flag, MaybeArg, _OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(_Arg) ->
- map__set(OptionTable0, Flag, bool(no), OptionTable),
- Result = ok(OptionTable)
- ;
- map__set(OptionTable0, Flag, bool(yes), OptionTable),
- Result = ok(OptionTable)
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ svset__insert(Flag, !OptionsSet),
+ ( MaybeArg = yes(_Arg) ->
+ map__set(OptionTable0, Flag, bool(no), OptionTable),
+ Result = ok(OptionTable)
+ ;
+ map__set(OptionTable0, Flag, bool(yes), OptionTable),
+ Result = ok(OptionTable)
+ ).
getopt__process_option(int(_), Option, Flag, MaybeArg, _OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(Arg) ->
- ( string__to_int(Arg, IntArg) ->
- map__set(OptionTable0, Flag, int(IntArg), OptionTable),
- Result = ok(OptionTable)
- ;
- getopt__numeric_argument(Option, Arg, Result)
- )
- ;
- error("integer argument expected in getopt__process_option")
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ svset__insert(Flag, !OptionsSet),
+ ( MaybeArg = yes(Arg) ->
+ ( string__to_int(Arg, IntArg) ->
+ map__set(OptionTable0, Flag, int(IntArg), OptionTable),
+ Result = ok(OptionTable)
+ ;
+ getopt__numeric_argument(Option, Arg, Result)
+ )
+ ;
+ error("integer argument expected in getopt__process_option")
+ ).
getopt__process_option(string(_), _Option, Flag, MaybeArg, _OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(Arg) ->
- map__set(OptionTable0, Flag, string(Arg), OptionTable),
- Result = ok(OptionTable)
- ;
- error("string argument expected in getopt__process_option")
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ svset__insert(Flag, !OptionsSet),
+ ( MaybeArg = yes(Arg) ->
+ map__set(OptionTable0, Flag, string(Arg), OptionTable),
+ Result = ok(OptionTable)
+ ;
+ error("string argument expected in getopt__process_option")
+ ).
getopt__process_option(maybe_int(_), Option, Flag, MaybeArg, _OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(Arg) ->
- ( string__to_int(Arg, IntArg) ->
- map__set(OptionTable0, Flag, maybe_int(yes(IntArg)),
- OptionTable),
- Result = ok(OptionTable)
- ;
- getopt__numeric_argument(Option, Arg, Result)
- )
- ;
- error("integer argument expected in getopt__process_option")
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ svset__insert(Flag, !OptionsSet),
+ ( MaybeArg = yes(Arg) ->
+ ( string__to_int(Arg, IntArg) ->
+ map__set(OptionTable0, Flag, maybe_int(yes(IntArg)), OptionTable),
+ Result = ok(OptionTable)
+ ;
+ getopt__numeric_argument(Option, Arg, Result)
+ )
+ ;
+ error("integer argument expected in getopt__process_option")
+ ).
getopt__process_option(maybe_string(_), _Option, Flag, MaybeArg, _OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(Arg) ->
- map__set(OptionTable0, Flag, maybe_string(yes(Arg)),
- OptionTable),
- Result = ok(OptionTable)
- ;
- error("string argument expected in getopt__process_option")
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ svset__insert(Flag, !OptionsSet),
+ ( MaybeArg = yes(Arg) ->
+ map__set(OptionTable0, Flag, maybe_string(yes(Arg)), OptionTable),
+ Result = ok(OptionTable)
+ ;
+ error("string argument expected in getopt__process_option")
+ ).
getopt__process_option(accumulating(List0), _Option, Flag, MaybeArg, _OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(Arg) ->
- list__append(List0, [Arg], List),
- map__set(OptionTable0, Flag, accumulating(List), OptionTable),
- Result = ok(OptionTable)
- ;
- error("acumulating argument expected in getopt__process_option")
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ svset__insert(Flag, !OptionsSet),
+ ( MaybeArg = yes(Arg) ->
+ list__append(List0, [Arg], List),
+ map__set(OptionTable0, Flag, accumulating(List), OptionTable),
+ Result = ok(OptionTable)
+ ;
+ error("acumulating argument expected in getopt__process_option")
+ ).
getopt__process_option(special, Option, Flag, MaybeArg, OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(_Arg) ->
- error("no special argument expected in getopt__process_option")
- ;
- getopt__process_special(Option, Flag, none,
- OptionOps, OptionTable0, Result)
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ svset__insert(Flag, !OptionsSet),
+ ( MaybeArg = yes(_Arg) ->
+ error("no special argument expected in getopt__process_option")
+ ;
+ getopt__process_special(Option, Flag, none,
+ OptionOps, OptionTable0, Result, !OptionsSet)
+ ).
getopt__process_option(bool_special, Option, Flag, MaybeArg, OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(_Arg) ->
- getopt__process_special(Option, Flag, bool(no),
- OptionOps, OptionTable0, Result)
- ;
- getopt__process_special(Option, Flag, bool(yes),
- OptionOps, OptionTable0, Result)
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ svset__insert(Flag, !OptionsSet),
+ ( MaybeArg = yes(_Arg) ->
+ getopt__process_special(Option, Flag, bool(no),
+ OptionOps, OptionTable0, Result, !OptionsSet)
+ ;
+ getopt__process_special(Option, Flag, bool(yes),
+ OptionOps, OptionTable0, Result, !OptionsSet)
+ ).
getopt__process_option(int_special, Option, Flag, MaybeArg, OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(Arg) ->
- ( string__to_int(Arg, IntArg) ->
- getopt__process_special(Option, Flag, int(IntArg),
- OptionOps, OptionTable0, Result)
- ;
- getopt__numeric_argument(Option, Arg, Result)
- )
- ;
- error("int_special argument expected in getopt__process_option")
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ svset__insert(Flag, !OptionsSet),
+ ( MaybeArg = yes(Arg) ->
+ ( string__to_int(Arg, IntArg) ->
+ getopt__process_special(Option, Flag, int(IntArg),
+ OptionOps, OptionTable0, Result, !OptionsSet)
+ ;
+ getopt__numeric_argument(Option, Arg, Result)
+ )
+ ;
+ error("int_special argument expected in getopt__process_option")
+ ).
getopt__process_option(string_special, Option, Flag, MaybeArg, OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(Arg) ->
- getopt__process_special(Option, Flag, string(Arg),
- OptionOps, OptionTable0, Result)
- ;
- error("string_special argument expected in getopt__process_option")
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ svset__insert(Flag, !OptionsSet),
+ ( MaybeArg = yes(Arg) ->
+ getopt__process_special(Option, Flag, string(Arg),
+ OptionOps, OptionTable0, Result, !OptionsSet)
+ ;
+ error("string_special argument expected in getopt__process_option")
+ ).
getopt__process_option(maybe_string_special, Option, Flag, MaybeArg, OptionOps,
- OptionTable0, Result) :-
- ( MaybeArg = yes(_) ->
- getopt__process_special(Option, Flag, maybe_string(MaybeArg),
- OptionOps, OptionTable0, Result)
- ;
- error("maybe_string_special argument expected in getopt__process_option")
- ).
-
-
-:- pred process_negated_option(string, OptionType, option_ops(OptionType),
- option_table(OptionType), maybe_option_table(OptionType)).
-:- mode process_negated_option(in, in, in(option_ops), in, out) is det.
-
-process_negated_option(Option, Flag, OptionOps, OptionTable0, Result) :-
- ( map__search(OptionTable0, Flag, OptionData) ->
- ( OptionData = bool(_) ->
- map__set(OptionTable0, Flag, bool(no), OptionTable),
- Result = ok(OptionTable)
- ; OptionData = maybe_int(_) ->
- map__set(OptionTable0, Flag, maybe_int(no),
- OptionTable),
- Result = ok(OptionTable)
- ; OptionData = maybe_string(_) ->
- map__set(OptionTable0, Flag, maybe_string(no),
- OptionTable),
- Result = ok(OptionTable)
- ; OptionData = accumulating(_) ->
- map__set(OptionTable0, Flag, accumulating([]),
- OptionTable),
- Result = ok(OptionTable)
- ; OptionData = bool_special ->
- getopt__process_special(Option, Flag, bool(no),
- OptionOps, OptionTable0, Result)
- ; OptionData = maybe_string_special ->
- getopt__process_special(Option, Flag, maybe_string(no),
- OptionOps, OptionTable0, Result)
- ;
- string__append_list(["cannot negate option `", Option,
- "' -- only boolean options can be negated"],
- ErrorMsg),
- Result = error(ErrorMsg)
- )
- ;
- string__append_list(["unknown type for option `",
- Option, "'"], ErrorMsg),
- Result = error(ErrorMsg)
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ ( MaybeArg = yes(_) ->
+ getopt__process_special(Option, Flag, maybe_string(MaybeArg),
+ OptionOps, OptionTable0, Result, !OptionsSet)
+ ;
+ 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(OptionType)::out,
+ set(OptionType)::in, set(OptionType)::out) is det.
+
+process_negated_option(Option, Flag, OptionOps, OptionTable0, Result,
+ !OptionsSet) :-
+ ( map__search(OptionTable0, Flag, OptionData) ->
+ ( OptionData = bool(_) ->
+ svset__insert(Flag, !OptionsSet),
+ map__set(OptionTable0, Flag, bool(no), OptionTable),
+ Result = ok(OptionTable)
+ ; OptionData = maybe_int(_) ->
+ svset__insert(Flag, !OptionsSet),
+ map__set(OptionTable0, Flag, maybe_int(no), OptionTable),
+ Result = ok(OptionTable)
+ ; OptionData = maybe_string(_) ->
+ svset__insert(Flag, !OptionsSet),
+ map__set(OptionTable0, Flag, maybe_string(no), OptionTable),
+ Result = ok(OptionTable)
+ ; OptionData = accumulating(_) ->
+ svset__insert(Flag, !OptionsSet),
+ map__set(OptionTable0, Flag, accumulating([]), OptionTable),
+ Result = ok(OptionTable)
+ ; OptionData = bool_special ->
+ svset__insert(Flag, !OptionsSet),
+ getopt__process_special(Option, Flag, bool(no),
+ OptionOps, OptionTable0, Result, !OptionsSet)
+ ; OptionData = maybe_string_special ->
+ svset__insert(Flag, !OptionsSet),
+ getopt__process_special(Option, Flag, maybe_string(no),
+ OptionOps, OptionTable0, Result, !OptionsSet)
+ ;
+ string__append_list(["cannot negate option `", Option,
+ "' -- only boolean options can be negated"],
+ ErrorMsg),
+ Result = error(ErrorMsg)
+ )
+ ;
+ string__append_list(["unknown type for option `",
+ Option, "'"], ErrorMsg),
+ Result = error(ErrorMsg)
+ ).
:- pred getopt__process_special(string::in, OptionType::in, special_data::in,
- option_ops(OptionType)::in(option_ops), option_table(OptionType)::in,
- maybe_option_table(OptionType)::out) is det.
+ option_ops_internal(OptionType)::in(option_ops_internal),
+ option_table(OptionType)::in, maybe_option_table(OptionType)::out,
+ set(OptionType)::in, set(OptionType)::out) is det.
getopt__process_special(Option, Flag, OptionData, OptionOps,
- OptionTable0, Result) :-
- (
- getopt__get_special_handler(OptionOps, Handler)
- ->
- (
- call(Handler, Flag, OptionData, OptionTable0, Result0)
- ->
- Result = Result0
- ;
- string__append_list(["the handler of option `",
- Option, "' failed"], ErrorMsg),
- Result = error(ErrorMsg)
- )
- ;
- string__append_list(["option `", Option, "' has no handler"],
- ErrorMsg),
- Result = error(ErrorMsg)
- ).
+ OptionTable0, Result, !OptionsSet) :-
+ MaybeHandler = OptionOps ^ special_handler,
+ (
+ MaybeHandler = notrack(Handler),
+ (
+ call(Handler, Flag, OptionData, OptionTable0, Result0)
+ ->
+ Result = Result0
+ ;
+ string__append_list(["the handler of option `",
+ Option, "' failed"], ErrorMsg),
+ Result = error(ErrorMsg)
+ )
+ ;
+ MaybeHandler = track(TrackHandler),
+ (
+ call(TrackHandler, Flag, OptionData, OptionTable0, Result0,
+ NewOptionsSet)
+ ->
+ set__union(NewOptionsSet, !OptionsSet),
+ Result = Result0
+ ;
+ string__append_list(["the handler of option `",
+ Option, "' failed"], ErrorMsg),
+ Result = error(ErrorMsg)
+ )
+ ;
+ MaybeHandler = none,
+ string__append_list(["option `", Option, "' has no handler"],
+ ErrorMsg),
+ Result = error(ErrorMsg)
+ ).
%-----------------------------------------------------------------------------%
@@ -697,105 +832,77 @@
getopt__need_arg(maybe_string_special, yes).
:- pred getopt__numeric_argument(string::in, string::in,
- maybe_option_table(OptionType)::out) is det.
+ maybe_option_table(OptionType)::out) is det.
getopt__numeric_argument(Option, Arg, Result) :-
- string__append_list(["option `", Option,
- "' requires a numeric argument; `", Arg,
- "' is not numeric"], ErrorMsg),
- Result = error(ErrorMsg).
-
-%-----------------------------------------------------------------------------%
-
-:- pred getopt__get_short_options(option_ops(OptionType)::in(option_ops),
- pred(char, OptionType)::out(pred(in, out) is semidet)) is det.
-
-getopt__get_short_options(option_ops(ShortOpt, _, _), ShortOpt).
-getopt__get_short_options(option_ops(ShortOpt, _, _, _), ShortOpt).
-
-:- pred getopt__get_long_options(option_ops(OptionType)::in(option_ops),
- pred(string, OptionType)::out(pred(in, out) is semidet)) is det.
-
-getopt__get_long_options(option_ops(_, LongOpt, _), LongOpt).
-getopt__get_long_options(option_ops(_, LongOpt, _, _), LongOpt).
-
-:- pred getopt__get_option_defaults(option_ops(OptionType)::in(option_ops),
- pred(OptionType, option_data)::out(pred(out, out) is nondet)) is det.
-
-getopt__get_option_defaults(option_ops(_, _, OptionDefs), OptionDefs).
-getopt__get_option_defaults(option_ops(_, _, OptionDefs, _), OptionDefs).
-
-:- pred getopt__get_special_handler(option_ops(OptionType)::in(option_ops),
- pred(OptionType, special_data,
- option_table(OptionType), maybe_option_table(OptionType))::
- out(pred(in, in, in, out) is semidet)) is semidet.
-
-getopt__get_special_handler(option_ops(_, _, _, SpecHandler), SpecHandler).
+ string__append_list(["option `", Option,
+ "' requires a numeric argument; `", Arg, "' is not numeric"],
+ ErrorMsg),
+ Result = error(ErrorMsg).
%-----------------------------------------------------------------------------%
getopt__lookup_bool_option(OptionTable, Opt, Val) :-
- ( map__lookup(OptionTable, Opt, bool(Val0)) ->
- Val = Val0
- ;
- error("Expected bool option and didn't get one.")
- ).
+ ( map__lookup(OptionTable, Opt, bool(Val0)) ->
+ Val = Val0
+ ;
+ error("Expected bool option and didn't get one.")
+ ).
getopt__lookup_int_option(OptionTable, Opt, Val) :-
- ( map__lookup(OptionTable, Opt, int(Val0)) ->
- Val = Val0
- ;
- error("Expected int option and didn't get one.")
- ).
+ ( map__lookup(OptionTable, Opt, int(Val0)) ->
+ Val = Val0
+ ;
+ error("Expected int option and didn't get one.")
+ ).
getopt__lookup_string_option(OptionTable, Opt, Val) :-
- ( map__lookup(OptionTable, Opt, string(Val0)) ->
- Val = Val0
- ;
- error("Expected string option and didn't get one.")
- ).
+ ( map__lookup(OptionTable, Opt, string(Val0)) ->
+ Val = Val0
+ ;
+ error("Expected string option and didn't get one.")
+ ).
getopt__lookup_maybe_int_option(OptionTable, Opt, Val) :-
- ( map__lookup(OptionTable, Opt, maybe_int(Val0)) ->
- Val = Val0
- ;
- error("Expected maybe_int option and didn't get one.")
- ).
+ ( map__lookup(OptionTable, Opt, maybe_int(Val0)) ->
+ Val = Val0
+ ;
+ error("Expected maybe_int option and didn't get one.")
+ ).
getopt__lookup_maybe_string_option(OptionTable, Opt, Val) :-
- ( map__lookup(OptionTable, Opt, maybe_string(Val0)) ->
- Val = Val0
- ;
- error("Expected maybe_string option and didn't get one.")
- ).
+ ( map__lookup(OptionTable, Opt, maybe_string(Val0)) ->
+ Val = Val0
+ ;
+ error("Expected maybe_string option and didn't get one.")
+ ).
getopt__lookup_accumulating_option(OptionTable, Opt, Val) :-
- ( map__lookup(OptionTable, Opt, accumulating(Val0)) ->
- Val = Val0
- ;
- error("Expected accumulating option and didn't get one.")
- ).
+ ( map__lookup(OptionTable, Opt, accumulating(Val0)) ->
+ Val = Val0
+ ;
+ error("Expected accumulating option and didn't get one.")
+ ).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Ralph Becket <rwab1 at cl.cam.ac.uk> 29/04/99
-% Functional forms added.
+% Functional forms added.
getopt__lookup_bool_option(OT, Opt) = B :-
- getopt__lookup_bool_option(OT, Opt, B).
+ getopt__lookup_bool_option(OT, Opt, B).
getopt__lookup_int_option(OT, Opt) = N :-
- getopt__lookup_int_option(OT, Opt, N).
+ getopt__lookup_int_option(OT, Opt, N).
getopt__lookup_string_option(OT, Opt) = S :-
- getopt__lookup_string_option(OT, Opt, S).
+ getopt__lookup_string_option(OT, Opt, S).
getopt__lookup_maybe_int_option(OT, Opt) = MN :-
- getopt__lookup_maybe_int_option(OT, Opt, MN).
+ getopt__lookup_maybe_int_option(OT, Opt, MN).
getopt__lookup_maybe_string_option(OT, Opt) =MS :-
- getopt__lookup_maybe_string_option(OT, Opt, MS).
+ getopt__lookup_maybe_string_option(OT, Opt, MS).
getopt__lookup_accumulating_option(OT, Opt) =Ss :-
- getopt__lookup_accumulating_option(OT, Opt, Ss).
-
+ getopt__lookup_accumulating_option(OT, Opt, Ss).
Index: library/library.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.78
diff -u -r1.78 library.m
--- library/library.m 15 Dec 2004 06:57:40 -0000 1.78
+++ library/library.m 15 Dec 2004 07:09:38 -0000
@@ -98,6 +98,7 @@
:- import_module store.
:- import_module string.
:- import_module svmap.
+:- import_module svset.
:- import_module term.
:- import_module term_io.
:- import_module term_to_xml.
@@ -223,6 +224,7 @@
mercury_std_library_module("store").
mercury_std_library_module("string").
mercury_std_library_module("svmap").
+mercury_std_library_module("svset").
mercury_std_library_module("table_builtin").
mercury_std_library_module("term").
mercury_std_library_module("term_io").
Index: library/map.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/map.m,v
retrieving revision 1.90
diff -u -r1.90 map.m
--- library/map.m 15 Dec 2004 06:57:41 -0000 1.90
+++ library/map.m 15 Dec 2004 07:09:38 -0000
@@ -282,6 +282,8 @@
% Apply a transformation predicate to all the values
% in a map, while continuously updating an accumulator.
:- pred map__map_foldl(pred(K, V, W, A, A), map(K, V), map(K, W), A, A).
+:- mode map__map_foldl(pred(in, in, out, di, uo) is det, in, out, di, uo)
+ is det.
:- mode map__map_foldl(pred(in, in, out, in, out) is det, in, out, in, out)
is det.
:- mode map__map_foldl(pred(in, in, out, in, out) is semidet, in, out, in, out)
@@ -392,8 +394,17 @@
:- pragma type_spec(map__lookup/2, K = var(_)).
:- pragma type_spec(map__lookup/2, K = int).
+:- pragma type_spec(map__insert(in, in, in, out), K = var(_)).
+:- pragma type_spec(map__insert(in, in, in, out), K = int).
+
+:- pragma type_spec(map__det_insert(in, in, in, out), K = var(_)).
+:- pragma type_spec(map__det_insert(in, in, in, out), K = int).
+
:- pragma type_spec(map__set(in, in, in, out), K = var(_)).
-:- pragma type_spec(map__set/3, K = var(_)).
+:- pragma type_spec(map__set(in, in, in, out), K = int).
+
+:- pragma type_spec(map__update(in, in, in, out), K = var(_)).
+:- pragma type_spec(map__update(in, in, in, out), K = int).
:- pragma type_spec(map__det_update/4, K = var(_)).
:- pragma type_spec(map__det_update/4, K = int).
Index: library/svmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/svmap.m,v
retrieving revision 1.1
diff -u -r1.1 svmap.m
--- library/svmap.m 14 Dec 2004 07:33:33 -0000 1.1
+++ library/svmap.m 15 Dec 2004 06:33:00 -0000
@@ -92,7 +92,31 @@
%-----------------------------------------------------------------------------%
+% Everything below here is not intended to be part of the public interface,
+% and will not be included in the Mercury library reference manual.
+
+:- interface.
+
+:- import_module term. % for var/1.
+
+:- pragma type_spec(svmap__insert(in, in, in, out), K = var(_)).
+:- pragma type_spec(svmap__insert(in, in, in, out), K = int).
+
+:- pragma type_spec(svmap__det_insert(in, in, in, out), K = var(_)).
+:- pragma type_spec(svmap__det_insert(in, in, in, out), K = int).
+
+:- pragma type_spec(svmap__set(in, in, in, out), K = var(_)).
+:- pragma type_spec(svmap__set(in, in, in, out), K = var(_)).
+
+:- pragma type_spec(svmap__update(in, in, in, out), K = var(_)).
+:- pragma type_spec(svmap__update(in, in, in, out), K = int).
+
+:- pragma type_spec(svmap__det_update(in, in, in, out), K = var(_)).
+:- pragma type_spec(svmap__det_update(in, in, in, out), K = int).
+
:- implementation.
+
+%-----------------------------------------------------------------------------%
svmap__insert(K, V, Map0, Map) :-
map__insert(Map0, K, V, Map).
Index: library/svset.m
===================================================================
RCS file: library/svset.m
diff -N library/svset.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/svset.m 15 Dec 2004 06:35:39 -0000
@@ -0,0 +1,105 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 1994-1997, 1999-2004 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+
+% File: set.m.
+% Authors: zs.
+% Stability: high.
+
+% This file provides an interface to the 'set' ADT that is conducive to the
+% use of state variable notation. The predicates here do the same thing as
+% their counterparts in the set module; the only difference is the order of
+% the arguments.
+
+%--------------------------------------------------------------------------%
+
+:- module svset.
+:- interface.
+:- import_module list, set.
+
+ % `svset__insert(X, Set0, Set)' is true iff `Set' is the union of
+ % `Set0' and the set containing only `X'.
+
+:- pred svset__insert(T::in, set(T)::in, set(T)::out) is det.
+
+ % `svset__insert_list(Xs, Set0, Set)' is true iff `Set' is the union of
+ % `Set0' and the set containing only the members of `Xs'.
+
+:- pred svset__insert_list(list(T)::in, set(T)::in, set(T)::out) is det.
+
+ % `svset__delete(X, Set0, Set)' is true iff `Set' is the relative
+ % complement of `Set0' and the set containing only `X', i.e.
+ % if `Set' is the set which contains all the elements of `Set0'
+ % except `X'.
+
+:- pred svset__delete(T::in, set(T)::in, set(T)::out) is det.
+
+ % `svset__delete_list(Xs, Set0, Set)' is true iff `Set' is the relative
+ % complement of `Set0' and the set containing only the members of
+ % `Xs'.
+
+:- pred svset__delete_list(list(T)::in, set(T)::in, set(T)::out) is det.
+
+ % `svset__remove(X, Set0, Set)' is true iff `Set0' contains `X',
+ % and `Set' is the relative complement of `Set0' and the set
+ % containing only `X', i.e. if `Set' is the set which contains
+ % all the elements of `Set0' except `X'.
+
+:- pred svset__remove(T::in, set(T)::in, set(T)::out) is semidet.
+
+ % `svset__remove_list(Xs, Set0, Set)' is true iff `Xs' does not
+ % contain any duplicates, `Set0' contains every member of `Xs',
+ % and `Set' is the relative complement of `Set0' and the set
+ % containing only the members of `Xs'.
+
+:- pred svset__remove_list(list(T)::in, set(T)::in, set(T)::out) is semidet.
+
+ % `svset__remove_least(Elem, Set0, Set)' is true iff
+ % `Set0' is not empty, `Elem' is the smallest element in `Set0'
+ % (with elements ordered using the standard ordering given
+ % by compare/3), and `Set' is the set containing all the
+ % elements of `Set0' except `Elem'.
+
+:- pred svset__remove_least(T::out, set(T)::in, set(T)::out) is semidet.
+
+%--------------------------------------------------------------------------%
+
+:- implementation.
+
+% Everything below here is not intended to be part of the public interface,
+% and will not be included in the Mercury library reference manual.
+
+:- interface.
+
+:- import_module term. % for var/1.
+
+:- pragma type_spec(svset__insert/3, T = var(_)).
+
+:- pragma type_spec(svset__insert_list/3, T = var(_)).
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+svset__insert(X, Set0, Set) :-
+ set__insert(Set0, X, Set).
+
+svset__insert_list(X, Set0, Set) :-
+ set__insert_list(Set0, X, Set).
+
+svset__delete(X, Set0, Set) :-
+ set__delete(Set0, X, Set).
+
+svset__delete_list(X, Set0, Set) :-
+ set__delete_list(Set0, X, Set).
+
+svset__remove(X, Set0, Set) :-
+ set__remove(Set0, X, Set).
+
+svset__remove_list(X, Set0, Set) :-
+ set__remove_list(Set0, X, Set).
+
+svset__remove_least(X, Set0, Set) :-
+ set__remove_least(Set0, X, Set).
Index: library/tree234.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/tree234.m,v
retrieving revision 1.43
diff -u -r1.43 tree234.m
--- library/tree234.m 15 Dec 2004 06:57:41 -0000 1.43
+++ library/tree234.m 15 Dec 2004 07:09:39 -0000
@@ -173,6 +173,8 @@
:- pred tree234__map_foldl(pred(K, V, W, A, A), tree234(K, V), tree234(K, W),
A, A).
+:- mode tree234__map_foldl(pred(in, in, out, di, uo) is det,
+ in, out, di, uo) is det.
:- mode tree234__map_foldl(pred(in, in, out, in, out) is det,
in, out, in, out) is det.
:- mode tree234__map_foldl(pred(in, in, out, in, out) is semidet,
cvs diff: Diffing profiler
Index: profiler/mercury_profile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/profiler/mercury_profile.m,v
retrieving revision 1.27
diff -u -r1.27 mercury_profile.m
--- profiler/mercury_profile.m 2 Dec 2004 08:01:10 -0000 1.27
+++ profiler/mercury_profile.m 15 Dec 2004 11:40:43 -0000
@@ -42,7 +42,7 @@
main(!IO) :-
io__command_line_arguments(Args0, !IO),
- OptionOps = option_ops(short_option, long_option, option_defaults,
+ OptionOps = option_ops_multi(short_option, long_option, option_default,
special_handler),
getopt__process_options(OptionOps, Args0, Args, Result0),
postprocess_options(Result0, Args, Result, !IO),
Index: profiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/profiler/options.m,v
retrieving revision 1.16
diff -u -r1.16 options.m
--- profiler/options.m 2 Dec 2004 08:01:10 -0000 1.16
+++ profiler/options.m 15 Dec 2004 06:47:15 -0000
@@ -40,8 +40,7 @@
:- pred short_option(character::in, option::out) is semidet.
:- pred long_option(string::in, option::out) is semidet.
-:- pred option_defaults(option::out, option_data::out) is nondet.
-:- pred option_default(option::out, option_data::out) is multidet.
+:- pred option_default(option::out, option_data::out) is multi.
:- pred special_handler(option::in, special_data::in,
option_table::in, maybe_option_table(option)::out) is semidet.
@@ -57,10 +56,6 @@
:- implementation.
:- import_module std_util, map.
-
-option_defaults(Option, Default) :-
- semidet_succeed,
- option_default(Option, Default).
% Verbosity Options
option_default(verbose, bool(no)).
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list