diff: check for unbound inst vars
Fergus Henderson
fjh at kryten.cs.mu.OZ.AU
Sun Sep 28 19:32:25 AEST 1997
Hi,
Tyson, can you please review this one?
Fix a bug: the compiler was not checking for unbound inst variables
in mode declarations.
compiler/typecheck.m:
compiler/inst_match.m:
Add code to check for unbound inst variables.
tests/invalid/Mmake:
tests/invalid/unbound_inst_var.m:
tests/invalid/unbound_inst_var.err_exp:
Regression test.
cvs diff -N compiler/inst_match.m compiler/typecheck.m tests/invalid/Mmake tests/invalid/unbound_inst_var.err_exp tests/invalid/unbound_inst_var.m
Index: compiler/inst_match.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inst_match.m,v
retrieving revision 1.36
diff -u -r1.36 inst_match.m
--- 1.36 1997/09/15 20:09:54
+++ inst_match.m 1997/09/28 08:32:23
@@ -225,6 +225,13 @@
:- pred inst_contains_instname(inst, module_info, inst_name).
:- mode inst_contains_instname(in, in, in) is semidet.
+ % Nondeterministically produce all the inst_vars contained
+ % in the specified list of modes.
+
+:- type inst_var == var.
+:- pred mode_list_contains_inst_var(list(mode), module_info, inst_var).
+:- mode mode_list_contains_inst_var(in, in, out) is nondet.
+
% Given a list of insts, and a corresponding list of livenesses,
% return true iff for every element in the list of insts, either
% the elemement is ground or the corresponding element in the liveness
@@ -247,7 +254,7 @@
:- implementation.
:- import_module hlds_data, mode_util, prog_data, inst_util.
-:- import_module list, set, map, std_util, require.
+:- import_module list, set, map, term, std_util, require.
inst_matches_initial(InstA, InstB, ModuleInfo) :-
set__init(Expansions),
@@ -1223,6 +1230,79 @@
inst_list_contains_instname(Insts, ModuleInfo, Expansions,
InstName)
).
+
+%-----------------------------------------------------------------------------%
+
+:- pred inst_contains_inst_var(inst, module_info, inst_var).
+:- mode inst_contains_inst_var(in, in, out) is nondet.
+
+inst_contains_inst_var(Inst, ModuleInfo, InstVar) :-
+ set__init(Expansions),
+ inst_contains_inst_var_2(Inst, ModuleInfo, Expansions, InstVar).
+
+:- pred inst_contains_inst_var_2(inst, module_info, set(inst_name), inst_var).
+:- mode inst_contains_inst_var_2(in, in, in, out) is nondet.
+
+inst_contains_inst_var_2(inst_var(InstVar), _, _, InstVar).
+inst_contains_inst_var_2(defined_inst(InstName), ModuleInfo, Expansions0,
+ InstVar) :-
+ \+ set__member(InstName, Expansions0),
+ inst_lookup(ModuleInfo, InstName, Inst),
+ set__insert(Expansions0, InstName, Expansions),
+ inst_contains_inst_var_2(Inst, ModuleInfo, Expansions, InstVar).
+inst_contains_inst_var_2(bound(_Uniq, ArgInsts), ModuleInfo, Expansions,
+ InstVar) :-
+ bound_inst_list_contains_inst_var(ArgInsts, ModuleInfo, Expansions,
+ InstVar).
+inst_contains_inst_var_2(ground(_Uniq, PredInstInfo), ModuleInfo, Expansions,
+ InstVar) :-
+ PredInstInfo = yes(pred_inst_info(_PredOrFunc, Modes, _Det)),
+ mode_list_contains_inst_var_2(Modes, ModuleInfo, Expansions, InstVar).
+inst_contains_inst_var_2(abstract_inst(_Name, ArgInsts), ModuleInfo, Expansions,
+ InstVar) :-
+ inst_list_contains_inst_var(ArgInsts, ModuleInfo, Expansions, InstVar).
+
+:- pred bound_inst_list_contains_inst_var(list(bound_inst), module_info,
+ set(inst_name), inst_var).
+:- mode bound_inst_list_contains_inst_var(in, in, in, out) is nondet.
+
+bound_inst_list_contains_inst_var([BoundInst|BoundInsts], ModuleInfo,
+ Expansions, InstVar) :-
+ BoundInst = functor(_Functor, ArgInsts),
+ (
+ inst_list_contains_inst_var(ArgInsts, ModuleInfo, Expansions,
+ InstVar)
+ ;
+ bound_inst_list_contains_inst_var(BoundInsts, ModuleInfo,
+ Expansions, InstVar)
+ ).
+
+:- pred inst_list_contains_inst_var(list(inst), module_info, set(inst_name),
+ inst_var).
+:- mode inst_list_contains_inst_var(in, in, in, out) is nondet.
+
+inst_list_contains_inst_var([Inst|Insts], ModuleInfo, Expansions, InstVar) :-
+ (
+ inst_contains_inst_var_2(Inst, ModuleInfo, Expansions, InstVar)
+ ;
+ inst_list_contains_inst_var(Insts, ModuleInfo, Expansions,
+ InstVar)
+ ).
+
+mode_list_contains_inst_var(Modes, ModuleInfo, InstVar) :-
+ set__init(Expansions),
+ mode_list_contains_inst_var_2(Modes, ModuleInfo, Expansions, InstVar).
+
+:- pred mode_list_contains_inst_var_2(list(mode), module_info, set(inst_name),
+ inst_var).
+:- mode mode_list_contains_inst_var_2(in, in, in, out) is nondet.
+
+mode_list_contains_inst_var_2([Mode|_Modes], ModuleInfo, Expansions, InstVar) :-
+ mode_get_insts_semidet(ModuleInfo, Mode, Initial, Final),
+ ( Inst = Initial ; Inst = Final ),
+ inst_contains_inst_var_2(Inst, ModuleInfo, Expansions, InstVar).
+mode_list_contains_inst_var_2([_|Modes], ModuleInfo, Expansions, InstVar) :-
+ mode_list_contains_inst_var_2(Modes, ModuleInfo, Expansions, InstVar).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.214
diff -u -r1.214 typecheck.m
--- 1.214 1997/09/02 07:13:18
+++ typecheck.m 1997/09/28 09:19:51
@@ -163,7 +163,7 @@
:- import_module hlds_goal, hlds_data, prog_util, type_util, code_util.
:- import_module prog_data, prog_io, prog_io_util, prog_out, hlds_out.
:- import_module mercury_to_mercury, mode_util, options, getopt, globals.
-:- import_module passes_aux, clause_to_proc, special_pred.
+:- import_module passes_aux, clause_to_proc, special_pred, inst_match.
:- import_module int, list, map, set, string, require, std_util, tree234.
:- import_module assoc_list, varset, term, term_io.
@@ -246,16 +246,14 @@
% Ensure that all constructors occurring in predicate mode
% declarations are module qualified.
%
- {
- pred_info_arg_types(PredInfo0, _, ArgTypes),
- pred_info_procedures(PredInfo0, Procs0),
+ { pred_info_arg_types(PredInfo0, _, ArgTypes) },
+ { pred_info_procedures(PredInfo0, Procs0) },
typecheck_propagate_types_into_proc_modes(
- ModuleInfo0, ProcIds, ArgTypes, Procs0, Procs),
- pred_info_set_procedures(PredInfo0, Procs, PredInfo),
- map__set(Preds0, PredId, PredInfo, Preds),
- module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1),
- Changed2 = Changed0
- }
+ ModuleInfo0, PredId, ProcIds, ArgTypes, Procs0, Procs),
+ { pred_info_set_procedures(PredInfo0, Procs, PredInfo) },
+ { map__set(Preds0, PredId, PredInfo, Preds) },
+ { module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1) },
+ { Changed2 = Changed0 }
;
typecheck_pred_type(PredId, PredInfo0, ModuleInfo0,
ModeError, MaybePredInfo, Changed1),
@@ -282,10 +280,11 @@
typecheck_pred_type(PredId, PredInfo0, ModuleInfo, ModeError,
MaybePredInfo, Changed, IOState0, IOState) :-
typecheck_pred_type_2(PredId, PredInfo0, ModuleInfo, MaybePredInfo0,
- Changed, IOState0, IOState),
+ Changed, IOState0, IOState1),
(
MaybePredInfo0 = no,
- MaybePredInfo = no
+ MaybePredInfo = no,
+ IOState = IOState1
;
MaybePredInfo0 = yes(PredInfo1),
@@ -302,30 +301,62 @@
pred_info_procedures(PredInfo3, Procs1),
pred_info_procids(PredInfo3, ProcIds),
typecheck_propagate_types_into_proc_modes(
- ModuleInfo, ProcIds, ArgTypes, Procs1, Procs),
+ ModuleInfo, PredId, ProcIds, ArgTypes,
+ Procs1, Procs,
+ IOState1, IOState),
pred_info_set_procedures(PredInfo3, Procs, PredInfo)
;
- PredInfo = PredInfo1
+ PredInfo = PredInfo1,
+ IOState = IOState1
),
MaybePredInfo = yes(PredInfo)
).
:- pred typecheck_propagate_types_into_proc_modes(module_info,
- list(proc_id), list(type), proc_table, proc_table).
+ pred_id, list(proc_id), list(type), proc_table, proc_table,
+ io__state, io__state).
:- mode typecheck_propagate_types_into_proc_modes(in,
- in, in, in, out) is det.
+ in, in, in, in, out, di, uo) is det.
-typecheck_propagate_types_into_proc_modes(_, [], _, Procs, Procs).
-typecheck_propagate_types_into_proc_modes(ModuleInfo, [ProcId | ProcIds],
- ArgTypes, Procs0, Procs) :-
- map__lookup(Procs0, ProcId, ProcInfo0),
- proc_info_argmodes(ProcInfo0, ArgModes0),
- propagate_types_into_mode_list(ArgTypes, ModuleInfo,
- ArgModes0, ArgModes),
- proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo),
- map__det_update(Procs0, ProcId, ProcInfo, Procs1),
- typecheck_propagate_types_into_proc_modes(ModuleInfo, ProcIds,
+typecheck_propagate_types_into_proc_modes(_, _, [], _, Procs, Procs) --> [].
+typecheck_propagate_types_into_proc_modes(ModuleInfo, PredId,
+ [ProcId | ProcIds], ArgTypes, Procs0, Procs) -->
+ { map__lookup(Procs0, ProcId, ProcInfo0) },
+ { proc_info_argmodes(ProcInfo0, ArgModes0) },
+ { propagate_types_into_mode_list(ArgTypes, ModuleInfo,
+ ArgModes0, ArgModes) },
+ %
+ % check for unbound inst vars
+ % (this needs to be done after propagate_types_into_mode_list,
+ % because we need the insts to be module-qualified; and it
+ % needs to be done before mode analysis, to avoid internal errors)
+ %
+ ( { mode_list_contains_inst_var(ArgModes, ModuleInfo, _InstVar) } ->
+ unbound_inst_var_error(PredId, ProcInfo0, ModuleInfo),
+ % delete this mode, to avoid internal errors
+ { map__det_remove(Procs0, ProcId, _, Procs1) }
+ ;
+ { proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo) },
+ { map__det_update(Procs0, ProcId, ProcInfo, Procs1) }
+ ),
+ typecheck_propagate_types_into_proc_modes(ModuleInfo, PredId, ProcIds,
ArgTypes, Procs1, Procs).
+
+:- pred unbound_inst_var_error(pred_id, proc_info, module_info,
+ io__state, io__state).
+:- mode unbound_inst_var_error(in, in, in, di, uo) is det.
+
+unbound_inst_var_error(PredId, ProcInfo, ModuleInfo) -->
+ { proc_info_context(ProcInfo, Context) },
+ io__set_exit_status(1),
+ prog_out__write_context(Context),
+ io__write_string("In mode declaration for "),
+ hlds_out__write_pred_id(ModuleInfo, PredId),
+ io__write_string(":\n"),
+ prog_out__write_context(Context),
+ io__write_string(" error: unbound inst variable(s).\n"),
+ prog_out__write_context(Context),
+ io__write_string(" (Sorry, polymorphic modes are not supported.)\n").
:- pred typecheck_pred_type_2(pred_id, pred_info, module_info,
maybe(pred_info), bool, io__state, io__state).
Index: tests/invalid/Mmake
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmake,v
retrieving revision 1.22
diff -u -r1.22 Mmake
--- 1.22 1997/09/14 09:12:38
+++ Mmake 1997/09/28 09:25:56
@@ -32,6 +32,7 @@
pragma_c_code_and_clauses2.m \
qual_basic_test2.m \
type_loop.m \
+ unbound_inst_var.m \
undef_lambda_mode.m \
undef_mode.m \
undef_type.m
Index: tests/invalid/unbound_inst_var.err_exp
===================================================================
RCS file: unbound_inst_var.err_exp
diff -N unbound_inst_var.err_exp
--- /dev/null Sun Sep 28 16:49:38 1997
+++ unbound_inst_var.err_exp Sun Sep 28 19:27:09 1997
@@ -0,0 +1,5 @@
+unbound_inst_var.m:019: In mode declaration for predicate `unbound_inst_var:test/1':
+unbound_inst_var.m:019: error: unbound inst variable(s).
+unbound_inst_var.m:019: (Sorry, polymorphic modes are not supported.)
+unbound_inst_var.m:018: Error: no mode declaration for predicate `unbound_inst_var:test/1'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/unbound_inst_var.m
===================================================================
RCS file: unbound_inst_var.m
diff -N unbound_inst_var.m
--- /dev/null Sun Sep 28 16:49:38 1997
+++ unbound_inst_var.m Sun Sep 28 19:26:57 1997
@@ -0,0 +1,29 @@
+:- module unbound_inst_var.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state,io__state).
+:- mode main(di,uo) is det.
+
+:- implementation.
+
+:- import_module char.
+
+:- type all(X) ---> a(X) ; b ; c ; d.
+
+:- inst all(X) ---> a(X) ; ground.
+
+:- pred test(all(char)).
+:- mode test(in(all(_))) is det.
+
+test(_) :- true.
+
+%:- pred main(io__state,io__state).
+%:- mode main(di,uo) is det.
+
+main(IO,IO) :-
+ true.
+
+:- end_module unbound_inst_var.
--
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.
More information about the developers
mailing list