[m-rev.] diff: cleanup handle_options.m

Zoltan Somogyi zs at cs.mu.OZ.AU
Mon Mar 15 17:56:46 AEDT 2004


compiler/handle_options.m:
	Bring this module up to date with our current style guidelines.
	Use predmode declarations where appropriate. Use state variable syntax
	where appropriate. Turn the very deeply nested if-then-else into
	a sequence of non-nested if-then-elses.

compiler/trace_params.m:
	Add a predicate for use by the new code of handle_options.m.

Zoltan.

cvs diff: Diffing .
Index: handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.201
diff -u -b -r1.201 handle_options.m
--- handle_options.m	10 Mar 2004 04:30:31 -0000	1.201
+++ handle_options.m	10 Mar 2004 06:46:58 -0000
@@ -24,36 +24,33 @@
 :- import_module list, bool, getopt, std_util, io.
 
 	% handle_options(Args, MaybeError, OptionArgs, NonOptionArgs, Link).
-:- pred handle_options(list(string), maybe(string), list(string),
-		list(string), bool, io__state, io__state).
-:- mode handle_options(in, out, out, out, out, di, uo) is det.
+:- pred handle_options(list(string)::in, maybe(string)::out, list(string)::out,
+	list(string)::out, bool::out, io::di, io::uo) is det.
 
 	% process_options(Args, OptionArgs, NonOptionArgs, MaybeOptionTable).
 	%
 	% Process the options, but don't do any post-processing or
 	% modify the globals. This is mainly useful for separating
 	% the list of arguments into option and non-option arguments.
-:- pred process_options(list(string), list(string), list(string),
-			maybe_option_table(option)).
-:- mode process_options(in, out, out, out) is det.
+:- pred process_options(list(string)::in, list(string)::out, list(string)::out,
+	maybe_option_table(option)::out) is det.
 
 	% usage_error(Descr, Message)
 	%
 	% Display the description of the error location, the error message
 	% and then a usage message.
-:- pred usage_error(string::in, string::in,
-		io__state::di, io__state::uo) is det.
+:- pred usage_error(string::in, string::in, io::di, io::uo) is det.
 
 	% usage_error(Message)
 	%
 	% Display error message and then usage message
-:- pred usage_error(string::in, io__state::di, io__state::uo) is det.
+:- pred usage_error(string::in, io::di, io::uo) is det.
 
 	% Display usage message.
-:- pred usage(io__state::di, io__state::uo) is det.
+:- pred usage(io::di, io::uo) is det.
 
 	% Display long usage message for help
-:- pred long_usage(io__state::di, io__state::uo) is det.
+:- pred long_usage(io::di, io::uo) is det.
 
 	% Given the current set of options, figure out
 	% which grade to use.
@@ -131,18 +128,16 @@
 process_options(Args0, OptionArgs, Args, Result) :-
 	OptionOps = option_ops(short_option, long_option,
 		option_defaults, special_handler),
-	getopt__process_options(OptionOps, Args0,
-		OptionArgs, Args, Result).
+	getopt__process_options(OptionOps, Args0, OptionArgs, Args, Result).
 
-:- pred dump_arguments(list(string), io__state, io__state).
-:- mode dump_arguments(in, di, uo) is det.
+:- pred dump_arguments(list(string)::in, io::di, io::uo) is det.
 
-dump_arguments([]) --> [].
-dump_arguments([Arg | Args]) -->
-	io__write_string("<"),
-	io__write_string(Arg),
-	io__write_string(">\n"),
-	dump_arguments(Args).
+dump_arguments([], !IO).
+dump_arguments([Arg | Args], !IO) :-
+	io__write_string("<", !IO),
+	io__write_string(Arg, !IO),
+	io__write_string(">\n", !IO),
+	dump_arguments(Args, !IO).
 
 %-----------------------------------------------------------------------------%
 
@@ -150,117 +145,151 @@
 % and process implications among the options (i.e. situations where setting
 % one option implies setting/unsetting another one).
 
-:- pred postprocess_options(maybe_option_table(option), maybe(string),
-	io__state, io__state).
-:- mode postprocess_options(in, out, di, uo) is det.
+:- pred postprocess_options(maybe_option_table(option)::in, maybe(string)::out,
+	io::di, io::uo) is det.
 
-postprocess_options(error(ErrorMessage), yes(ErrorMessage)) --> [].
-postprocess_options(ok(OptionTable), Error) -->
-    { map__lookup(OptionTable, target, Target0) },
+postprocess_options(error(ErrorMessage), yes(ErrorMessage), !IO).
+postprocess_options(ok(OptionTable0), MaybeError, !IO) :-
+	check_option_values(OptionTable0, OptionTable, Target, GC_Method,
+		TagsMethod, TermNorm, TraceLevel, TraceSuppress, [], Errors),
+	( Errors = [] ->
+		postprocess_options_2(OptionTable, Target, GC_Method,
+			TagsMethod, TermNorm, TraceLevel, TraceSuppress,
+			MaybeError, !IO)
+	;
+		Error = string__join_list("\n", Errors),
+		MaybeError = yes(Error)
+	).
+
+:- pred check_option_values(option_table::in, option_table::out,
+	compilation_target::out, gc_method::out, tags_method::out,
+	termination_norm::out, trace_level::out, trace_suppress_items::out,
+	list(string)::in, list(string)::out) is det.
+
+check_option_values(OptionTable0, OptionTable, Target, GC_Method, TagsMethod,
+		TermNorm, TraceLevel, TraceSuppress, !Errors) :-
+	map__lookup(OptionTable0, target, Target0),
     (
-        { Target0 = string(TargetStr) },
-        { convert_target(TargetStr, Target) }
+		Target0 = string(TargetStr),
+		convert_target(TargetStr, TargetPrime)
     ->
-        { map__lookup(OptionTable, gc, GC_Method0) },
+		Target = TargetPrime
+	;
+		Target = c,		% dummy
+		add_error("Invalid target option " ++
+			"(must be `c', `asm', `il', or `java')", !Errors)
+	),
+	map__lookup(OptionTable0, gc, GC_Method0),
         (
-            { GC_Method0 = string(GC_MethodStr) },
-            { convert_gc_method(GC_MethodStr, GC_Method) }
+		GC_Method0 = string(GC_MethodStr),
+		convert_gc_method(GC_MethodStr, GC_MethodPrime)
         ->
-            { map__lookup(OptionTable, tags, TagsMethod0) },
+		GC_Method = GC_MethodPrime
+	;
+		GC_Method = none,	% dummy
+		add_error("Invalid GC option (must be `none', " ++
+			"`conservative', `boehm', `mps', `accurate', " ++
+			"or `automatic')", !Errors)
+	),
+	map__lookup(OptionTable0, tags, TagsMethod0),
             (
-                { TagsMethod0 = string(TagsMethodStr) },
-                { convert_tags_method(TagsMethodStr, TagsMethod) }
+		TagsMethod0 = string(TagsMethodStr),
+		convert_tags_method(TagsMethodStr, TagsMethodPrime)
             ->
-                { map__lookup(OptionTable, fact_table_hash_percent_full,
-                    PercentFull) },
+		TagsMethod = TagsMethodPrime
+	;
+		TagsMethod = none,	% dummy
+		add_error("Invalid tags option " ++
+			"(must be `none', `low' or `high')", !Errors)
+	),
+	map__lookup(OptionTable0, fact_table_hash_percent_full, PercentFull),
                 (
-                    { PercentFull = int(Percent) },
-                    { Percent >= 1 },
-                    { Percent =< 100 }
+		PercentFull = int(Percent),
+		Percent >= 1,
+		Percent =< 100
                 ->
-                    { map__lookup(OptionTable, termination_norm,
-                        TermNorm0) },
+		true
+	;
+		add_error("Invalid argument to option " ++
+			"`--fact-table-hash-percent-full'\n\t" ++
+			"(must be an integer between 1 and 100)", !Errors)
+	),
+	map__lookup(OptionTable0, termination_norm, TermNorm0),
                     (
-                        { TermNorm0 = string(TermNormStr) },
-                        { convert_termination_norm(TermNormStr, TermNorm) }
+		TermNorm0 = string(TermNormStr),
+		convert_termination_norm(TermNormStr, TermNormPrime)
                     ->
-                        { map__lookup(OptionTable, trace, Trace) },
-                        { map__lookup(OptionTable, require_tracing,
-                            RequireTracingOpt) },
-                        { map__lookup(OptionTable, decl_debug,
-                            DeclDebugOpt) },
+		TermNorm = TermNormPrime
+	;
+		TermNorm = simple,	% dummy
+		add_error("Invalid argument to option " ++
+			"`--termination-norm'\n\t(must be " ++
+			"`simple', `total' or  `num-data-elems').", !Errors)
+	),
+	map__lookup(OptionTable0, trace, Trace),
+	map__lookup(OptionTable0, require_tracing, RequireTracingOpt),
+	map__lookup(OptionTable0, decl_debug, DeclDebugOpt),
                         (
-                            { Trace = string(TraceStr) },
-                            { RequireTracingOpt = bool(RequireTracing) },
-                            { DeclDebugOpt = bool(DeclDebug) },
-                            { convert_trace_level(TraceStr, RequireTracing,
-                                DeclDebug, MaybeTraceLevel) }
+		Trace = string(TraceStr),
+		RequireTracingOpt = bool(RequireTracing),
+		DeclDebugOpt = bool(DeclDebug),
+		convert_trace_level(TraceStr, RequireTracing, DeclDebug,
+			MaybeTraceLevel)
                         ->
                             (
-                                { MaybeTraceLevel = yes(TraceLevel) },
-                                { map__lookup(OptionTable, suppress_trace,
-                                    Suppress) },
+			MaybeTraceLevel = yes(TraceLevel)
+		;
+			MaybeTraceLevel = no,
+			TraceLevel = trace_level_none,	% dummy
+			add_error("Specified trace level is not " ++
+				"compatible with grade", !Errors)
+		)
+	;
+		TraceLevel = trace_level_none,	% dummy
+		add_error("Invalid argument to option `--trace'\n\t" ++
+			"(must be `minimum', `shallow', `deep', `decl', " ++
+			"`rep' or `default').", !Errors)
+	),
+	map__lookup(OptionTable0, suppress_trace, Suppress),
                                 (
-                                    { Suppress = string(SuppressStr) },
-                                    { convert_trace_suppress(SuppressStr,
-                                        TraceSuppress) }
+		Suppress = string(SuppressStr),
+		convert_trace_suppress(SuppressStr, TraceSuppressPrime)
                                 ->
-                                    { map__lookup(OptionTable, dump_hlds_alias,
-                                        DumpAliasOption) },
+		TraceSuppress = TraceSuppressPrime
+	;
+		TraceSuppress = default_trace_suppress,	% dummy
+		add_error("Invalid argument to option `--suppress-trace'.",
+			!Errors)
+	),
+	map__lookup(OptionTable0, dump_hlds_alias, DumpAliasOption),
                                     (
-                                        { DumpAliasOption = string(DumpAlias) },
-                                        { DumpAlias = "" }
+		DumpAliasOption = string(DumpAlias),
+		DumpAlias = ""
                                     ->
-                                        postprocess_options_2(OptionTable,
-                                            Target, GC_Method, TagsMethod,
-                                            TermNorm, TraceLevel,
-                                            TraceSuppress, Error)
+		OptionTable = OptionTable0
                                     ;
-                                        { DumpAliasOption = string(DumpAlias) },
-                                        { convert_dump_alias(DumpAlias,
-                                            DumpOptions) }
+		DumpAliasOption = string(DumpAlias),
+		convert_dump_alias(DumpAlias, DumpOptions)
                                     ->
-                                        { map__set(OptionTable,
-                                            dump_hlds_options,
-                                            string(DumpOptions),
-                                            NewOptionTable) },
-                                        postprocess_options_2(NewOptionTable,
-                                            Target, GC_Method, TagsMethod,
-                                            TermNorm, TraceLevel,
-                                            TraceSuppress, Error)
-                                    ;
-                                        { Error = yes("Invalid argument to option `--hlds-dump-alias'.") }
-                                    )
-                                ;
-                                    { Error = yes("Invalid argument to option `--suppress-trace'.") }
-                                )
-                            ;
-                                { MaybeTraceLevel = no },
-                                { Error = yes("Specified trace level is not compatible with grade") }
-                            )
-                        ;
-                            { Error = yes("Invalid argument to option `--trace'\n\t(must be `minimum', `shallow', `deep', `decl', `rep' or `default').") }
-                        )
-                    ;
-                        { Error = yes("Invalid argument to option `--termination-norm'\n\t(must be `simple', `total' or  `num-data-elems').") }
-                    )
-                ;
-                    { Error = yes("Invalid argument to option `--fact-table-hash-percent-full'\n\t(must be an integer between 1 and 100)") }
-                )
+		map__set(OptionTable0, dump_hlds_options, string(DumpOptions),
+			OptionTable)
             ;
-                { Error = yes("Invalid tags option (must be `none', `low' or `high')") }
-            )
-        ;
-            { Error = yes("Invalid GC option (must be `none', `conservative', `boehm', `mps', `accurate', or `automatic')") }
-	)
-    ;
-        { Error = yes("Invalid target option (must be `c', `asm', `il', or `java')") }
+		OptionTable = OptionTable0,	% dummy
+		add_error("Invalid argument to option `--hlds-dump-alias'.",
+			!Errors)
     ).
 
+:- pred add_error(string::in, list(string)::in, list(string)::out) is det.
+
+add_error(Error, Errors0, Errors) :-
+	% We won't be appending enough errors for the quadratic complexity
+	% of repeated appends to be a problem.
+	list__append(Errors0, [Error], Errors).
+
 :- pred postprocess_options_2(option_table::in, compilation_target::in,
     gc_method::in, tags_method::in, termination_norm::in,
     trace_level::in, trace_suppress_items::in, maybe(string)::out,
-    io__state::di, io__state::uo) is det.
+	io::di, io::uo) is det.
 
 postprocess_options_2(OptionTable0, Target, GC_Method, TagsMethod0,
 		TermNorm, TraceLevel, TraceSuppress, Error) -->
@@ -1356,7 +1385,7 @@
 	% code generator, because sometimes the same option has different
 	% meanings and implications in the two backends.
 	%
-:- pred postprocess_options_lowlevel(io__state::di, io__state::uo) is det.
+:- pred postprocess_options_lowlevel(io::di, io::uo) is det.
 
 postprocess_options_lowlevel -->
 		% The low level code generator assumes that const(_) rvals are
@@ -1380,7 +1409,7 @@
 % If the SourceBoolOption is set to yes, then the ImpliedOption is set
 % to ImpliedOptionValue.
 :- pred option_implies(option::in, option::in, option_data::in,
-	io__state::di, io__state::uo) is det.
+	io::di, io::uo) is det.
 
 option_implies(SourceOption, ImpliedOption, ImpliedOptionValue) -->
 	globals__io_lookup_bool_option(SourceOption, SourceOptionValue),
@@ -1395,7 +1424,7 @@
 % If the SourceBoolOption is set to no, then the ImpliedOption is set
 % to ImpliedOptionValue.
 :- pred option_neg_implies(option::in, option::in, option_data::in,
-	io__state::di, io__state::uo) is det.
+	io::di, io::uo) is det.
 
 option_neg_implies(SourceOption, ImpliedOption, ImpliedOptionValue) -->
 	globals__io_lookup_bool_option(SourceOption, SourceOptionValue),
@@ -1410,7 +1439,7 @@
 % If the SourceBoolOption is set to yes, and RequiredOption is not set
 % to RequiredOptionValue, then report a usage error.
 :- pred option_requires(option::in, option::in, option_data::in,
-		string::in, io__state::di, io__state::uo) is det.
+	string::in, io::di, io::uo) is det.
 
 option_requires(SourceOption, RequiredOption, RequiredOptionValue,
 		ErrorMessage) -->
@@ -1430,19 +1459,18 @@
 		string::in, io__state::di, io__state::uo) is det.
 
 maybe_disable_smart_recompilation(Smart, ConflictingOption,
-		ValueToDisableSmart, OptionDescr) -->
-	globals__io_lookup_bool_option(ConflictingOption, Value),
+		ValueToDisableSmart, OptionDescr, !IO) :-
+	globals__io_lookup_bool_option(ConflictingOption, Value, !IO),
 	(
-		{ Smart = yes },
-		{ Value = ValueToDisableSmart }
+		Smart = yes,
+		Value = ValueToDisableSmart
 	->
-		disable_smart_recompilation(OptionDescr)
+		disable_smart_recompilation(OptionDescr, !IO)
 	;
-		[]
+		true
 	).
 
-:- pred disable_smart_recompilation(string::in,
-		io__state::di, io__state::uo) is det.
+:- pred disable_smart_recompilation(string::in, io::di, io::uo) is det.
 
 disable_smart_recompilation(OptionDescr) -->
 	globals__io_set_option(smart_recompilation, bool(no)),
@@ -1463,45 +1491,48 @@
 		[]
 	).
 
-usage_error(ErrorDescr, ErrorMessage) -->
-	write_program_name,
-	io__write_string(ErrorDescr),
-	io__nl,
-	usage_error(ErrorMessage).
-
-usage_error(ErrorMessage) -->
-	write_program_name,
-	io__write_string(ErrorMessage),
-	io__write_string("\n"),
-	io__set_exit_status(1),
-	usage.
+usage_error(ErrorDescr, ErrorMessage, !IO) :-
+	write_program_name(!IO),
+	io__write_string(ErrorDescr, !IO),
+	io__nl(!IO),
+	usage_error(ErrorMessage, !IO).
+
+usage_error(ErrorMessage, !IO) :-
+	write_program_name(!IO),
+	io__write_string(ErrorMessage, !IO),
+	io__write_string("\n", !IO),
+	io__set_exit_status(1, !IO),
+	usage(!IO).
 
 :- pred write_program_name(io__state::di, io__state::uo) is det.
 
-write_program_name -->
-	io__progname_base("mercury_compile", ProgName),
-	io__write_string(ProgName),
-	io__write_string(": ").
+write_program_name(!IO) :-
+	io__progname_base("mercury_compile", ProgName, !IO),
+	io__write_string(ProgName, !IO),
+	io__write_string(": ", !IO).
 
-usage -->
-	{ library__version(Version) },
+usage(!IO) :-
+	library__version(Version),
  	io__write_strings([
 		"Mercury Compiler, version ", Version, "\n",
 		"Copyright (C) 1993-2004 The University of Melbourne\n",
 		"Usage: mmc [<options>] <arguments>\n",
 		"Use `mmc --help' for more information.\n"
-	]).
+	], !IO).
 
-long_usage -->
-	{ library__version(Version) },
- 	io__write_strings(["Mercury Compiler, version ", Version, "\n"]),
- 	io__write_string("Copyright (C) 1993-2004 The University of Melbourne\n"),
-	io__write_string("Usage: mmc [<options>] <arguments>\n"),
-	io__write_string("Arguments:\n"),
-	io__write_string("\tArguments ending in `.m' are assumed to be source file names.\n"),
-	io__write_string("\tArguments that do not end in `.m' are assumed to be module names.\n"),
-	io__write_string("Options:\n"),
-	options_help.
+long_usage(!IO) :-
+	library__version(Version),
+ 	io__write_strings(["Mercury Compiler, version ", Version, "\n"], !IO),
+ 	io__write_string("Copyright (C) 1993-2004 " ++
+		"The University of Melbourne\n", !IO),
+	io__write_string("Usage: mmc [<options>] <arguments>\n", !IO),
+	io__write_string("Arguments:\n", !IO),
+	io__write_string("\tArguments ending in `.m' " ++
+		"are assumed to be source file names.\n", !IO),
+	io__write_string("\tArguments that do not end in `.m' " ++
+		"are assumed to be module names.\n", !IO),
+	io__write_string("Options:\n", !IO),
+	options_help(!IO).
 
 %-----------------------------------------------------------------------------%
 
@@ -1565,9 +1596,8 @@
 		)
 	), Components, Options1, Options, NoComps, _FinalComps).
 
-:- pred add_option_list(list(pair(option, option_data)), option_table,
-		option_table).
-:- mode add_option_list(in, in, out) is det.
+:- pred add_option_list(list(pair(option, option_data))::in, option_table::in,
+	option_table::out) is det.
 
 add_option_list(CompOpts, Opts0, Opts) :-
 	list__foldl((pred(Opt::in, Opts1::in, Opts2::out) is det :-
@@ -1583,10 +1613,8 @@
 	% implied by the file names (.pic_o vs .o, `.a' vs `.so').
 	%
 	(
-		string__sub_string_search(Grade0,
-			".picreg", PicRegIndex),
-		string__split(Grade0, PicRegIndex,
-			LeftPart, RightPart0),
+		string__sub_string_search(Grade0, ".picreg", PicRegIndex),
+		string__split(Grade0, PicRegIndex, LeftPart, RightPart0),
 		string__append(".picreg", RightPart, RightPart0)
 	->
 		Grade = LeftPart ++ RightPart
@@ -1605,8 +1633,8 @@
 		construct_string(Components, Grade)
 	).
 
-:- pred construct_string(list(pair(grade_component, string)), string).
-:- mode construct_string(in, out) is det.
+:- pred construct_string(list(pair(grade_component, string))::in, string::out)
+	is det.
 
 construct_string([], "").
 construct_string([_ - Bit|Bits], Grade) :-
@@ -1619,9 +1647,8 @@
 		Grade = Bit
 	).
 
-:- pred compute_grade_components(option_table,
-		list(pair(grade_component, string))).
-:- mode compute_grade_components(in, out) is det.
+:- pred compute_grade_components(option_table::in,
+	list(pair(grade_component, string))::out) is det.
 
 compute_grade_components(Options, GradeComponents) :-
 	solutions((pred(CompData::out) is nondet :-
@@ -1828,8 +1855,7 @@
 	[stack_trace - bool(yes), require_tracing - bool(no),
 	decl_debug - bool(no)], no).
 
-:- pred reset_grade_options(option_table, option_table).
-:- mode reset_grade_options(in, out) is det.
+:- pred reset_grade_options(option_table::in, option_table::out) is det.
 
 reset_grade_options(Options0, Options) :-
 	aggregate(grade_start_values,
@@ -1868,8 +1894,7 @@
 	string__to_char_list(GradeStr, Chars),
 	split_grade_string_2(Chars, Components).
 
-:- pred split_grade_string_2(list(char), list(string)).
-:- mode split_grade_string_2(in, out) is semidet.
+:- pred split_grade_string_2(list(char)::in, list(string)::out) is semidet.
 
 split_grade_string_2([], []).
 split_grade_string_2(Chars, Components) :-
@@ -1885,8 +1910,7 @@
 		RestComponents = []
 	).
 
-:- pred char_is_not(char, char).
-:- mode char_is_not(in, in) is semidet.
+:- pred char_is_not(char::in, char::in) is semidet.
 
 char_is_not(A, B) :-
 	A \= B.
@@ -1901,8 +1925,7 @@
 %
 % You are welcome to add more aliases.
 
-:- pred convert_dump_alias(string, string).
-:- mode convert_dump_alias(in, out) is semidet.
+:- pred convert_dump_alias(string::in, string::out) is semidet.
 
 convert_dump_alias("ALL", "abcdfgilmnprstuvCDIMPTU").
 convert_dump_alias("all", "abcdfgilmnprstuvCMPT").
Index: trace_params.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trace_params.m,v
retrieving revision 1.15
diff -u -b -r1.15 trace_params.m
--- trace_params.m	16 Mar 2003 08:01:31 -0000	1.15
+++ trace_params.m	10 Mar 2004 06:46:48 -0000
@@ -79,6 +79,7 @@
 
 :- pred convert_trace_suppress(string::in, trace_suppress_items::out)
 	is semidet.
+:- func default_trace_suppress = trace_suppress_items.
 
 	% These functions check for various properties of the global
 	% trace level.
@@ -283,6 +284,8 @@
 :- pred char_is_comma(char::in) is semidet.
 
 char_is_comma(',').
+
+default_trace_suppress = set__init.
 
 :- func convert_port_name(string) = trace_port is semidet.
 
cvs diff: Diffing notes
--------------------------------------------------------------------------
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