[m-dev.] diff: check type, mode and determinism of main/2
Fergus Henderson
fjh at cs.mu.OZ.AU
Mon Jul 24 21:35:03 AEST 2000
Estimated hours taken: 3
Fix a bug reported by Peter Ross <petdr at cs.mu.oz.au>:
check that type, mode, and determinism of main/2 conform to
what the Mercury language reference manual requires.
compiler/post_typecheck.m:
Check that the arguments of main/2 have type `io__state'.
compiler/type_util.m:
Add predicate `type_is_io_state', for use by post_typecheck.m.
compiler/modes.m:
Check the the arguments of main/2 have mode `di, uo'.
Also split some of the code in proc_check_eval_methods
out into separate procedures.
compiler/det_report.m:
Check that main/2 has determinism `det' or `cc_multi',
rather than just checking that it doesn't fail.
(We don't want to allow main/2 to have determinism `multi',
since that doesn't work in MLDS grades, for which `multi'
procedures have a different calling convention than
`det' or `cc_multi' procedures.
Similarly we don't want to allow main/2 to have determinism
`erroneous', since a future back-end might use a different
calling convention for that.)
tests/general/partition.m:
Change the declared determinism of main/2 from `multi' to `det',
to make this test case conform to the language reference manual.
This is needed now that the compiler checks the determinism of
main/2 properly.
tests/invalid/Mmakefile:
tests/invalid/invalid_main.m:
tests/invalid/invalid_main.err_exp:
A regression test.
Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.58
diff -u -d -r1.58 det_report.m
--- compiler/det_report.m 1999/10/25 03:48:45 1.58
+++ compiler/det_report.m 2000/07/24 09:17:19
@@ -134,7 +134,7 @@
PredInfo, ProcInfo) },
check_determinism(PredId, ProcId, PredInfo, ProcInfo,
ModuleInfo0, ModuleInfo1),
- check_if_main_can_fail(PredId, ProcId, PredInfo, ProcInfo,
+ check_determinism_of_main(PredId, ProcId, PredInfo, ProcInfo,
ModuleInfo1, ModuleInfo2),
check_for_multisoln_func(PredId, ProcId, PredInfo, ProcInfo,
ModuleInfo2, ModuleInfo3),
@@ -243,31 +243,26 @@
io__nl,
print_dets(Rest).
-:- pred check_if_main_can_fail(pred_id, proc_id, pred_info, proc_info,
+:- pred check_determinism_of_main(pred_id, proc_id, pred_info, proc_info,
module_info, module_info, io__state, io__state).
-:- mode check_if_main_can_fail(in, in, in, in, in, out, di, uo) is det.
+:- mode check_determinism_of_main(in, in, in, in, in, out, di, uo) is det.
-check_if_main_can_fail(_PredId, _ProcId, PredInfo, ProcInfo,
+check_determinism_of_main(_PredId, _ProcId, PredInfo, ProcInfo,
ModuleInfo0, ModuleInfo) -->
+ %
+ % check that `main/2' has determinism `det' or `cc_multi',
+ % as required by the language reference manual
+ %
{ proc_info_declared_determinism(ProcInfo, MaybeDetism) },
- { proc_info_inferred_determinism(ProcInfo, InferredDetism) },
- % check that `main/2' cannot fail
(
{ pred_info_name(PredInfo, "main") },
{ pred_info_arity(PredInfo, 2) },
{ pred_info_is_exported(PredInfo) },
- {
- determinism_components(InferredDetism, can_fail, _)
- ;
- MaybeDetism = yes(DeclaredDeterminism),
- determinism_components(DeclaredDeterminism, can_fail, _)
- }
+ { MaybeDetism = yes(DeclaredDetism) },
+ { DeclaredDetism \= det, DeclaredDetism \= cc_multidet }
->
{ proc_info_context(ProcInfo, Context1) },
prog_out__write_context(Context1),
- % The error message is actually a lie -
- % main/2 can also be `erroneous'. But mentioning
- % that would probably just confuse people.
io__write_string(
"Error: main/2 must be `det' or `cc_multi'.\n"),
{ module_info_incr_errors(ModuleInfo0, ModuleInfo) }
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.241
diff -u -d -r1.241 modes.m
--- compiler/modes.m 2000/07/24 10:28:06 1.241
+++ compiler/modes.m 2000/07/24 11:13:57
@@ -354,14 +354,14 @@
UnsafeToContinue),
( { WhatToCheck = check_unique_modes },
write_mode_inference_messages(PredIds, yes, ModuleInfo1),
- { ModuleInfo2 = ModuleInfo1 }
+ check_eval_methods(ModuleInfo1, ModuleInfo2)
; { WhatToCheck = check_modes },
( { UnsafeToContinue = yes } ->
write_mode_inference_messages(PredIds, no, ModuleInfo1)
;
[]
),
- check_eval_methods(ModuleInfo1, ModuleInfo2)
+ { ModuleInfo2 = ModuleInfo1 }
),
{ ModuleInfo = ModuleInfo2 }.
@@ -2132,6 +2132,9 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+% check that the evaluation method is OK for the given mode(s).
+% we also check the mode of main/2 here.
+
:- pred check_eval_methods(module_info, module_info, io__state, io__state).
:- mode check_eval_methods(in, out, di, uo) is det.
@@ -2158,34 +2161,15 @@
proc_check_eval_methods([], _, M, M) --> [].
proc_check_eval_methods([ProcId|Rest], PredId, ModuleInfo0, ModuleInfo) -->
{ module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
- _, ProcInfo) },
+ PredInfo, ProcInfo) },
{ proc_info_eval_method(ProcInfo, EvalMethod) },
- { proc_info_context(ProcInfo, Context) },
- { eval_method_to_string(EvalMethod, EvalMethodS) },
- globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
{ proc_info_argmodes(ProcInfo, Modes) },
(
{ eval_method_requires_ground_args(EvalMethod) = yes },
\+ { only_fully_in_out_modes(Modes, ModuleInfo0) }
->
- prog_out__write_context(Context),
- io__write_string("Sorry, not implemented: `pragma "),
- io__write_string(EvalMethodS),
- io__write_string("'\n"),
- prog_out__write_context(Context),
- io__write_string(
- " declaration not allowed for procedure with\n"),
- prog_out__write_context(Context),
- io__write_string(
- " partially instantiated modes.\n"),
- ( { VerboseErrors = yes } ->
- io__write_string(
-" Tabling of predicates/functions with partially instantiated modes
- is not currently implemented.\n")
- ;
- []
- ),
- { module_info_incr_errors(ModuleInfo0, ModuleInfo1) }
+ report_eval_method_requires_ground_args(ProcInfo,
+ ModuleInfo0, ModuleInfo1)
;
{ ModuleInfo1 = ModuleInfo0 }
),
@@ -2193,29 +2177,23 @@
{ eval_method_destroys_uniqueness(EvalMethod) = yes },
\+ { only_nonunique_modes(Modes, ModuleInfo1) }
->
- prog_out__write_context(Context),
- io__write_string("Error: `pragma "),
- io__write_string(EvalMethodS),
- io__write_string("'\n"),
- prog_out__write_context(Context),
- io__write_string(
- " declaration not allowed for procedure with\n"),
- prog_out__write_context(Context),
- io__write_string(" unique modes.\n"),
- ( { VerboseErrors = yes } ->
- io__write_string(
-" Tabling of predicates/functions with unique modes is not allowed
- as this would lead to a copying of the unique arguments which
- would result in them no longer being unique.\n")
- ;
- []
- ),
- { module_info_incr_errors(ModuleInfo1, ModuleInfo2) }
+ report_eval_method_destroys_uniqueness(ProcInfo,
+ ModuleInfo1, ModuleInfo2)
;
{ ModuleInfo2 = ModuleInfo1 }
-
),
- proc_check_eval_methods(Rest, PredId, ModuleInfo2, ModuleInfo).
+ (
+ { pred_info_name(PredInfo, "main") },
+ { pred_info_arity(PredInfo, 2) },
+ { pred_info_is_exported(PredInfo) },
+ { \+ check_mode_of_main(Modes, ModuleInfo2) }
+ ->
+ report_wrong_mode_for_main(ProcInfo,
+ ModuleInfo2, ModuleInfo3)
+ ;
+ { ModuleInfo3 = ModuleInfo2 }
+ ),
+ proc_check_eval_methods(Rest, PredId, ModuleInfo3, ModuleInfo).
:- pred only_fully_in_out_modes(list(mode), module_info).
:- mode only_fully_in_out_modes(in, in) is semidet.
@@ -2244,6 +2222,92 @@
inst_is_not_partly_unique(ModuleInfo, InitialInst),
inst_is_not_partly_unique(ModuleInfo, FinalInst),
only_nonunique_modes(Rest, ModuleInfo).
+
+:- pred check_mode_of_main(list(mode), module_info).
+:- mode check_mode_of_main(in, in) is semidet.
+
+check_mode_of_main([Di, Uo], ModuleInfo) :-
+ mode_get_insts(ModuleInfo, Di, DiInitialInst, DiFinalInst),
+ mode_get_insts(ModuleInfo, Uo, UoInitialInst, UoFinalInst),
+ %
+ % Note that we hard-code these tests,
+ % rather than using `inst_is_free', `inst_is_unique', etc.,
+ % since for main/2 we're looking for an exact match
+ % (modulo inst synonyms) with what the language reference
+ % manual specifies, rather than looking for a particular
+ % abstract property.
+ %
+ inst_expand(ModuleInfo, DiInitialInst, ground(unique, no)),
+ inst_expand(ModuleInfo, DiFinalInst, ground(clobbered, no)),
+ inst_expand(ModuleInfo, UoInitialInst, Free),
+ ( Free = free ; Free = free(_Type) ),
+ inst_expand(ModuleInfo, UoFinalInst, ground(unique, no)).
+
+:- pred report_eval_method_requires_ground_args(proc_info,
+ module_info, module_info, io__state, io__state).
+:- mode report_eval_method_requires_ground_args(in, in, out, di, uo) is det.
+
+report_eval_method_requires_ground_args(ProcInfo, ModuleInfo0, ModuleInfo) -->
+ { proc_info_eval_method(ProcInfo, EvalMethod) },
+ { proc_info_context(ProcInfo, Context) },
+ { eval_method_to_string(EvalMethod, EvalMethodS) },
+ globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+ prog_out__write_context(Context),
+ io__write_string("Sorry, not implemented: `pragma "),
+ io__write_string(EvalMethodS),
+ io__write_string("'\n"),
+ prog_out__write_context(Context),
+ io__write_string(
+ " declaration not allowed for procedure with\n"),
+ prog_out__write_context(Context),
+ io__write_string(
+ " partially instantiated modes.\n"),
+ ( { VerboseErrors = yes } ->
+ io__write_string(
+" Tabling of predicates/functions with partially instantiated modes
+ is not currently implemented.\n")
+ ;
+ []
+ ),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
+
+:- pred report_eval_method_destroys_uniqueness(proc_info,
+ module_info, module_info, io__state, io__state).
+:- mode report_eval_method_destroys_uniqueness(in, in, out, di, uo) is det.
+
+report_eval_method_destroys_uniqueness(ProcInfo, ModuleInfo0, ModuleInfo) -->
+ { proc_info_eval_method(ProcInfo, EvalMethod) },
+ { proc_info_context(ProcInfo, Context) },
+ { eval_method_to_string(EvalMethod, EvalMethodS) },
+ globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+ prog_out__write_context(Context),
+ io__write_string("Error: `pragma "),
+ io__write_string(EvalMethodS),
+ io__write_string("'\n"),
+ prog_out__write_context(Context),
+ io__write_string(
+ " declaration not allowed for procedure with\n"),
+ prog_out__write_context(Context),
+ io__write_string(" unique modes.\n"),
+ ( { VerboseErrors = yes } ->
+ io__write_string(
+" Tabling of predicates/functions with unique modes is not allowed
+ as this would lead to a copying of the unique arguments which
+ would result in them no longer being unique.\n")
+ ;
+ []
+ ),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
+
+:- pred report_wrong_mode_for_main(proc_info,
+ module_info, module_info, io__state, io__state).
+:- mode report_wrong_mode_for_main(in, in, out, di, uo) is det.
+
+report_wrong_mode_for_main(ProcInfo, ModuleInfo0, ModuleInfo) -->
+ { proc_info_context(ProcInfo, Context) },
+ prog_out__write_context(Context),
+ io__write_string("Error: main/2 must have mode `(di, uo)'.\n"),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.24
diff -u -d -r1.24 post_typecheck.m
--- compiler/post_typecheck.m 2000/06/06 05:45:22 1.24
+++ compiler/post_typecheck.m 2000/07/24 09:56:50
@@ -179,15 +179,24 @@
),
%
+ % check that main/2 has the right type
+ %
+ ( ReportErrs = yes ->
+ check_type_of_main(PredInfo, IOState2, IOState3)
+ ;
+ IOState3 = IOState2
+ ),
+
+ %
% Check that all Aditi predicates have an `aditi__state' argument.
% This must be done after typechecking because of type inference --
% the types of some Aditi predicates may not be known before.
%
pred_info_get_markers(PredInfo, Markers),
( ReportErrs = yes, check_marker(Markers, aditi) ->
- check_aditi_state(ModuleInfo, PredInfo, IOState2, IOState)
+ check_aditi_state(ModuleInfo, PredInfo, IOState3, IOState)
;
- IOState = IOState2
+ IOState = IOState3
).
:- pred check_type_bindings_2(assoc_list(prog_var, (type)), list(tvar),
@@ -573,6 +582,7 @@
post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
PredInfo0, PredInfo).
+
%
% For ill-typed preds, we just need to set the modes up correctly
% so that any calls to that pred from correctly-typed predicates
@@ -655,6 +665,44 @@
% record which predicates are used in assertions
{ assertion__record_preds_used_in(Goal, AssertionId, Module3, Module) }.
+%-----------------------------------------------------------------------------%
+
+:- pred check_type_of_main(pred_info, io__state, io__state).
+:- mode check_type_of_main(in, di, uo) is det.
+
+check_type_of_main(PredInfo) -->
+ (
+ %
+ % Check if this predicate is the
+ % program entry point main/2.
+ %
+ { pred_info_name(PredInfo, "main") },
+ { pred_info_arity(PredInfo, 2) },
+ { pred_info_is_exported(PredInfo) }
+ ->
+ %
+ % Check that the arguments of main/2
+ % have type `io__state'.
+ %
+ { pred_info_arg_types(PredInfo, ArgTypes) },
+ (
+ { ArgTypes = [Arg1, Arg2] },
+ { type_is_io_state(Arg1) },
+ { type_is_io_state(Arg2) }
+ ->
+ []
+ ;
+ { pred_info_context(PredInfo, Context) },
+ error_util__write_error_pieces(Context, 0,
+ [words("Error: arguments of main/2"),
+ words("must have type `io__state'.")]),
+ io__set_exit_status(1)
+ )
+ ;
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
%
% Ensure that all constructors occurring in predicate mode
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.83
diff -u -d -r1.83 type_util.m
--- compiler/type_util.m 2000/06/06 05:45:28 1.83
+++ compiler/type_util.m 2000/07/24 09:43:14
@@ -59,6 +59,9 @@
:- pred type_util__is_dummy_argument_type(type).
:- mode type_util__is_dummy_argument_type(in) is semidet.
+:- pred type_is_io_state(type).
+:- mode type_is_io_state(in) is semidet.
+
:- pred type_is_aditi_state(type).
:- mode type_is_aditi_state(in) is semidet.
@@ -527,6 +530,10 @@
% XXX should we include aditi:state/0 in this list?
type_util__is_dummy_argument_type_2("io", "state", 0). % io:state/0
type_util__is_dummy_argument_type_2("store", "store", 1). % store:store/1.
+
+type_is_io_state(Type) :-
+ type_to_type_id(Type,
+ qualified(unqualified("io"), "state") - 0, []).
type_is_aditi_state(Type) :-
type_to_type_id(Type,
Index: tests/general/partition.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/partition.m,v
retrieving revision 1.5
diff -u -d -r1.5 partition.m
--- tests/general/partition.m 1997/02/23 06:11:34 1.5
+++ tests/general/partition.m 2000/07/24 09:35:34
@@ -18,7 +18,7 @@
:- interface.
:- import_module io, int, list, std_util.
-:- pred main(io__state::di, io__state::uo) is multidet.
+:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
cvs diff: tests/invalid/invalid_main.err_exp is a new entry, no comparison available
cvs diff: tests/invalid/invalid_main.m is a new entry, no comparison available
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.65
diff -u -d -r1.65 Mmakefile
--- tests/invalid/Mmakefile 2000/05/11 06:29:32 1.65
+++ tests/invalid/Mmakefile 2000/07/24 11:32:07
@@ -36,6 +36,7 @@
ho_unique_error.m \
impure_method_impl.m \
inline_conflict.m \
+ invalid_main.m \
inst_list_dup.m \
io_in_ite_cond.m \
missing_det_decls.m \
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list