[m-dev.] diff: fix Aditi error messages
Simon TAYLOR
stayl at cs.mu.OZ.AU
Fri May 5 12:43:02 AEST 2000
Estimated hours taken: 4
Fix the error messages reported for Aditi procedures.
compiler/magic.m:
Check the arguments of base relations.
compiler/magic_util.m:
Make sure the untransformed predicate name
is used in error messages.
Don't report errors for type-info and
typeclass-info arguments, unless there
are no polymorphic arguments.
Report errors for types containing
existentially quantified constructors.
compiler/post_typecheck.m:
Report an error if an Aditi procedure does not
have an input `aditi__state' argument.
tests/invalid/Mmakefile:
tests/invalid/aditi_errors.m:
tests/invalid/aditi_errors.err_exp:
tests/invalid/aditi_state_errors.m:
tests/invalid/aditi_state_errors.err_exp:
Test cases.
Index: compiler//magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.16
diff -u -u -r1.16 magic.m
--- compiler//magic.m 2000/04/14 08:38:01 1.16
+++ compiler//magic.m 2000/05/04 07:58:44
@@ -429,11 +429,26 @@
magic_info_get_module_info(ModuleInfo0),
{ module_info_pred_proc_info(ModuleInfo0, PredProcId,
PredInfo0, ProcInfo0) },
-
- % Remove aditi:states, convert arguments to output.
{ pred_info_arg_types(PredInfo0, TVarSet, ExistQVars, ArgTypes0) },
{ proc_info_argmodes(ProcInfo0, ArgModes0) },
{ proc_info_headvars(ProcInfo0, HeadVars0) },
+
+ magic_info_set_error_pred_proc_id(CPredProcId),
+ { set__init(ErrorVars) },
+ magic_info_set_error_vars(ErrorVars),
+
+ (
+ { pred_info_module(PredInfo0, ModuleName) },
+ { module_info_name(ModuleInfo0, ModuleName) }
+ ->
+ { pred_info_context(PredInfo0, Context) },
+ magic_util__check_args(HeadVars0, ArgModes0, ArgTypes0,
+ Context, arg_number)
+ ;
+ []
+ ),
+
+ % Remove aditi:states, convert arguments to output.
{ type_util__remove_aditi_state(ArgTypes0, ArgTypes0, ArgTypes) },
{ type_util__remove_aditi_state(ArgTypes0, ArgModes0, ArgModes1) },
{ list__map(magic_util__mode_to_output_mode(ModuleInfo0),
@@ -529,6 +544,9 @@
{ module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
PredInfo0, ProcInfo0) },
magic_info_set_curr_pred_proc_id(proc(PredId, ProcId)),
+ magic_info_set_error_pred_proc_id(proc(PredId, ProcId)),
+ { set__init(ErrorVars) },
+ magic_info_set_error_vars(ErrorVars),
%
% Create a new pred_info for the procedure.
@@ -594,6 +612,9 @@
magic_info_get_module_info(ModuleInfo0),
{ module_info_pred_proc_info(ModuleInfo0, AditiPredProcId,
PredInfo0, ProcInfo0) },
+ magic_info_set_error_pred_proc_id(CPredProcId),
+ { set__init(ErrorVars) },
+ magic_info_set_error_vars(ErrorVars),
magic__preprocess_proc(CPredProcId, PredInfo0,
ProcInfo0, ProcInfo1),
Index: compiler//magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.6
diff -u -u -r1.6 magic_util.m
--- compiler//magic_util.m 2000/04/14 08:38:02 1.6
+++ compiler//magic_util.m 2000/05/05 01:59:35
@@ -15,7 +15,6 @@
:- interface.
:- import_module hlds_data, hlds_goal, hlds_module, hlds_pred, prog_data.
-:- import_module (inst).
:- import_module bool, io, list, map, set, std_util.
% Check that the argument types and modes are legal for
@@ -120,6 +119,7 @@
:- import_module hlds_data, code_util, type_util, mode_util, inst_match.
:- import_module instmap, goal_util, prog_out, hlds_out, error_util, prog_util.
+:- import_module (inst), polymorphism.
:- import_module assoc_list, int, require, string, term, varset.
@@ -1106,22 +1106,40 @@
%-----------------------------------------------------------------------------%
magic_util__check_args(Vars, Modes, Types, Context, IdType) -->
- ( magic_util__check_args_2(Vars, Modes, Types, Context, 1, IdType) ->
- []
+ (
+ magic_util__check_args_2(Vars, Modes, Types, Context,
+ 1, IdType, no_rtti, MaybeRtti)
+ ->
+ (
+ { MaybeRtti = no_rtti }
+ ;
+ { MaybeRtti = found_rtti(RttiArg) },
+ magic_info_get_error_pred_proc_id(PredProcId),
+ magic_info_get_errors(Errors0),
+ { Error = nonspecific_polymorphism(PredProcId, RttiArg)
+ - Context },
+ { set__insert(Errors0, Error, Errors) },
+ magic_info_set_errors(Errors)
+ ;
+ { MaybeRtti = found_polymorphic }
+ )
;
{ error("magic_util__check_args") }
).
:- pred magic_util__check_args_2(list(prog_var)::in, list(mode)::in,
- list(type)::in, term__context::in, int::in, magic_arg_id_type::in,
+ list(type)::in, term__context::in, int::in,
+ magic_arg_id_type::in, rtti_arg_state::in, rtti_arg_state::out,
magic_info::in, magic_info::out) is semidet.
-magic_util__check_args_2([], [], [], _, _, _) --> [].
+magic_util__check_args_2([], [], [], _, _, _, Rtti, Rtti) --> [].
magic_util__check_args_2([Var | Vars], [ArgMode | ArgModes],
- [ArgType | ArgTypes], Context, ArgNo, ArgIdType) -->
+ [ArgType | ArgTypes], Context, ArgNo,
+ ArgIdType, Rtti0, Rtti) -->
magic_info_get_error_vars(ErrorVars0),
( { set__member(Var, ErrorVars0) } ->
- []
+ { NextArgNo = ArgNo + 1 },
+ { Rtti1 = Rtti0 }
;
(
{ ArgIdType = arg_number },
@@ -1134,7 +1152,7 @@
{ ArgId = var_name(VarName) }
),
- magic_info_get_curr_pred_proc_id(PredProcId),
+ magic_info_get_error_pred_proc_id(PredProcId),
magic_info_get_module_info(ModuleInfo),
( { type_is_aditi_state(ArgType) } ->
(
@@ -1157,7 +1175,7 @@
),
% Check that the argument types are legal.
- magic_util__check_type(ArgType, ErrorTypes),
+ magic_util__check_type(ArgType, ErrorTypes, MaybeRtti),
{ set__to_sorted_list(ErrorTypes, ErrorTypeList0) },
% Check that partially instantiated modes are not used.
@@ -1194,31 +1212,83 @@
{ set__insert_list(Errors1, StateError, Errors) },
magic_info_set_errors(Errors),
- { NextArgNo is ArgNo + 1 },
- magic_util__check_args_2(Vars, ArgModes, ArgTypes,
- Context, NextArgNo, ArgIdType)
- ).
+ { list__member(polymorphic, ErrorTypeList) ->
+ NextArgNo = ArgNo + 1,
+ Rtti1 = found_polymorphic
+ ; MaybeRtti = yes(RttiArg) ->
+ % Don't count type-infos when working
+ % out what number the current argument is.
+ NextArgNo = ArgNo,
+ update_rtti_arg_state(Rtti0, RttiArg, Rtti1)
+ ;
+ NextArgNo = ArgNo + 1,
+ Rtti1 = Rtti0
+ }
+ ),
+ magic_util__check_args_2(Vars, ArgModes, ArgTypes,
+ Context, NextArgNo, ArgIdType, Rtti1, Rtti).
+
+%-----------------------------------------------------------------------------%
+:- type rtti_arg_state
+ ---> no_rtti
+ ; found_rtti(rtti_arg)
+ ; found_polymorphic % Report errors for the polymorphic
+ % arguments, but don't report for the
+ % typeinfos and typeclass infos
+ .
+
+:- pred update_rtti_arg_state(rtti_arg_state::in,
+ rtti_arg::in, rtti_arg_state::out) is det.
+
+update_rtti_arg_state(no_rtti, Arg, found_rtti(Arg)).
+update_rtti_arg_state(found_rtti(Arg0), Arg1, found_rtti(Arg)) :-
+ update_rtti_arg(Arg0, Arg1, Arg).
+update_rtti_arg_state(found_polymorphic, _, found_polymorphic).
+
+:- pred update_rtti_arg(rtti_arg::in, rtti_arg::in, rtti_arg::out) is det.
+
+update_rtti_arg(both, _, both).
+update_rtti_arg(type_info, type_info, type_info).
+update_rtti_arg(type_info, typeclass_info, both).
+update_rtti_arg(type_info, both, both).
+update_rtti_arg(typeclass_info, typeclass_info, typeclass_info).
+update_rtti_arg(typeclass_info, type_info, both).
+update_rtti_arg(typeclass_info, both, both).
+
%-----------------------------------------------------------------------------%
+
% Go over a type collecting any reasons why that type cannot
% be an argument type of an Aditi relation.
:- pred magic_util__check_type((type)::in, set(argument_error)::out,
- magic_info::in, magic_info::out) is det.
+ maybe(rtti_arg)::out, magic_info::in, magic_info::out) is det.
-magic_util__check_type(ArgType, Errors) -->
- { set__init(Errors0) },
+magic_util__check_type(ArgType, Errors, MaybeRtti) -->
- % Polymorphic types are not allowed.
- { map__init(Subn) },
- ( { term__is_ground(ArgType, Subn) } ->
- { Errors1 = Errors0 }
- ;
- { set__insert(Errors0, polymorphic, Errors1) }
- ),
+ % Polymorphic types are not allowed.
+ % Errors for type_infos and typeclass_infos are only reported
+ % if there are no other polmorphic arguments.
+ ( { polymorphism__type_info_type(ArgType, _) } ->
+ { set__init(Errors) },
+ { MaybeRtti = yes(type_info) }
+ ; { polymorphism__typeclass_info_class_constraint(ArgType, _) } ->
+ { set__init(Errors) },
+ { MaybeRtti = yes(typeclass_info) }
+ ;
+ { MaybeRtti = no },
+ { map__init(Subn) },
+ { set__init(Errors0) },
+ { term__is_ground(ArgType, Subn) ->
+ Errors1 = Errors0
+ ;
+ set__insert(Errors0, polymorphic, Errors1)
+ },
- { set__init(Parents) },
- magic_util__traverse_type(yes, Parents, ArgType, Errors1, Errors).
+ { set__init(Parents) },
+ magic_util__traverse_type(yes, Parents, ArgType,
+ Errors1, Errors)
+ ).
:- pred magic_util__traverse_type(bool::in, set(type_id)::in, (type)::in,
set(argument_error)::in, set(argument_error)::out,
@@ -1303,10 +1373,15 @@
set(argument_error)::in, set(argument_error)::out,
magic_info::in, magic_info::out) is det.
-magic_util__check_ctor(Parents, ctor(_, _, _, CtorArgs), Errors0, Errors) -->
- { assoc_list__values(CtorArgs, CtorArgTypes) },
- list__foldl2(magic_util__traverse_type(no, Parents),
- CtorArgTypes, Errors0, Errors).
+magic_util__check_ctor(Parents, ctor(ExistQVars, _, _, CtorArgs),
+ Errors0, Errors) -->
+ ( { ExistQVars = [] } ->
+ { assoc_list__values(CtorArgs, CtorArgTypes) },
+ list__foldl2(magic_util__traverse_type(no, Parents),
+ CtorArgTypes, Errors0, Errors)
+ ;
+ { set__insert(Errors0, existentially_typed, Errors) }
+ ).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1347,6 +1422,8 @@
:- pred magic_info_get_module_info(module_info::out, magic_info::in,
magic_info::out) is det.
+:- pred magic_info_get_error_pred_proc_id(pred_proc_id::out, magic_info::in,
+ magic_info::out) is det.
:- pred magic_info_get_curr_pred_proc_id(pred_proc_id::out, magic_info::in,
magic_info::out) is det.
:- pred magic_info_get_pred_info(pred_info::out, magic_info::in,
@@ -1359,8 +1436,6 @@
magic_info::out) is det.
:- pred magic_info_get_magic_vars(list(prog_var)::out, magic_info::in,
magic_info::out) is det.
-:- pred magic_info_get_magic_insts(list(inst)::out, magic_info::in,
- magic_info::out) is det.
:- pred magic_info_get_magic_var_map(map(pred_proc_id, prog_var)::out,
magic_info::in, magic_info::out) is det.
:- pred magic_info_get_next_supp_id(int::out, magic_info::in,
@@ -1380,6 +1455,8 @@
:- pred magic_info_set_module_info(module_info::in, magic_info::in,
magic_info::out) is det.
+:- pred magic_info_set_error_pred_proc_id(pred_proc_id::in, magic_info::in,
+ magic_info::out) is det.
:- pred magic_info_set_curr_pred_proc_id(pred_proc_id::in, magic_info::in,
magic_info::out) is det.
:- pred magic_info_set_pred_info(pred_info::in, magic_info::in,
@@ -1392,8 +1469,6 @@
magic_info::out) is det.
:- pred magic_info_set_magic_vars(list(prog_var)::in, magic_info::in,
magic_info::out) is det.
-:- pred magic_info_set_magic_insts(list(inst)::in, magic_info::in,
- magic_info::out) is det.
:- pred magic_info_set_magic_var_map(map(pred_proc_id, prog_var)::in,
magic_info::in, magic_info::out) is det.
:- pred magic_info_set_magic_proc_info(map(pred_proc_id, magic_proc_info)::in,
@@ -1415,39 +1490,42 @@
:- type magic_info
---> magic_info(
- module_info,
- maybe(pred_proc_id),
- maybe(pred_info),
- maybe(proc_info),
- list(pred_proc_id), % preds in the current
+ module_info :: module_info,
+ error_pred_proc_id :: maybe(pred_proc_id),
+ curr_pred_proc_id :: maybe(pred_proc_id),
+ pred_info :: maybe(pred_info),
+ proc_info :: maybe(proc_info),
+ scc :: list(pred_proc_id),
+ % preds in the current
% sub-module
- magic_map, % magic pred_proc_id for
+ magic_map :: magic_map, % magic pred_proc_id for
% each pred_proc_id
- list(prog_var), % magic input variables
- list(inst), % insts of magic input vars
- map(pred_proc_id, prog_var),
+ magic_vars :: list(prog_var),
+ % magic input variables
+
+ magic_var_map :: map(pred_proc_id, prog_var),
% magic input variables for
% each entry-point of the
% sub-module
- int, % next supp id
- map(pred_proc_id, magic_proc_info),
- pred_map,
+ next_supp_id :: int, % next supp id
+ magic_proc_info :: map(pred_proc_id, magic_proc_info),
+ pred_map :: pred_map,
% map from old to transformed
% pred_proc_id
- set(prog_var), % vars for which errors have
+ error_vars :: set(prog_var),
+ % vars for which errors have
% been reported.
- magic_errors,
- set(type_id), % type_ids which are allowed
+ errors :: magic_errors,
+ ok_types :: set(type_id),
+ % type_ids which are allowed
% as argument types of
% Aditi predicates. A type
% is ok if no part of it is
% higher-order or abstract.
- map(type_id, set(argument_error)),
+ bad_types :: map(type_id, set(argument_error))
% type_ids which are not ok
% as Aditi argument types.
- unit,
- unit
).
%-----------------------------------------------------------------------------%
@@ -1461,136 +1539,98 @@
set__init(OKTypes),
map__init(BadTypes),
set__init(ErrorVars),
- MagicInfo = magic_info(ModuleInfo, no, no, no, [], MagicMap, [], [],
+ MagicInfo = magic_info(ModuleInfo, no, no, no, no, [], MagicMap, [],
VarMap, 1, MagicProcInfo, PredMap, ErrorVars, Errors,
- OKTypes, BadTypes, unit, unit).
+ OKTypes, BadTypes).
-magic_info_get_module_info(ModuleInfo, Info, Info) :-
- Info = magic_info(ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).
+magic_info_get_module_info(Info ^ module_info, Info, Info).
+
+magic_info_get_error_pred_proc_id(PredProcId, Info, Info) :-
+ ( Info ^ error_pred_proc_id = yes(PredProcId1) ->
+ PredProcId = PredProcId1
+ ;
+ error("magic_info_get_error_pred_proc_id")
+ ).
magic_info_get_curr_pred_proc_id(PredProcId, Info, Info) :-
- Info = magic_info(_,MaybePredProcId,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
- ( MaybePredProcId = yes(PredProcId1) ->
+ ( Info ^ curr_pred_proc_id = yes(PredProcId1) ->
PredProcId = PredProcId1
;
- error("magic_info_get_pred_info")
+ error("magic_info_get_curr_pred_proc_id")
).
magic_info_get_pred_info(PredInfo, Info, Info) :-
- Info = magic_info(_,_,MaybePredInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
- ( MaybePredInfo = yes(PredInfo1) ->
+ ( Info ^ pred_info = yes(PredInfo1) ->
PredInfo = PredInfo1
;
error("magic_info_get_pred_info")
).
magic_info_get_proc_info(ProcInfo, Info, Info) :-
- Info = magic_info(_,_,_,MaybeProcInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
- ( MaybeProcInfo = yes(ProcInfo1) ->
+ ( Info ^ proc_info = yes(ProcInfo1) ->
ProcInfo = ProcInfo1
;
error("magic_info_get_proc_info")
).
-
-magic_info_get_scc(SCC, Info, Info) :-
- Info = magic_info(_,_,_,_,SCC,_,_,_,_,_,_,_,_,_,_,_,_,_).
-magic_info_get_magic_map(Map, Info, Info) :-
- Info = magic_info(_,_,_,_,_,Map,_,_,_,_,_,_,_,_,_,_,_,_).
+magic_info_get_scc(Info ^ scc, Info, Info).
-magic_info_get_magic_vars(Vars, Info, Info) :-
- Info = magic_info(_,_,_,_,_,_,Vars,_,_,_,_,_,_,_,_,_,_,_).
+magic_info_get_magic_map(Info ^ magic_map, Info, Info).
-magic_info_get_magic_insts(Insts, Info, Info) :-
- Info = magic_info(_,_,_,_,_,_,_,Insts,_,_,_,_,_,_,_,_,_,_).
+magic_info_get_magic_vars(Info ^ magic_vars, Info, Info).
-magic_info_get_magic_var_map(VarMap, Info, Info) :-
- Info = magic_info(_,_,_,_,_,_,_,_,VarMap,_,_,_,_,_,_,_,_,_).
+magic_info_get_magic_var_map(Info ^ magic_var_map, Info, Info).
-magic_info_get_next_supp_id(SuppId0,
- magic_info(A,B,C,D,E,F,G,H,I,SuppId0,K,L,M,N,O,P,Q,R),
- magic_info(A,B,C,D,E,F,G,H,I,SuppId,K,L,M,N,O,P,Q,R)) :-
- SuppId is SuppId0 + 1.
+magic_info_get_next_supp_id(SuppId0, Info0,
+ Info0 ^ next_supp_id := SuppId0 + 1) :-
+ SuppId0 = Info0 ^ next_supp_id.
-magic_info_get_magic_proc_info(MagicProcInfo, Info, Info) :-
- Info = magic_info(_,_,_,_,_,_,_,_,_,_,MagicProcInfo,_,_,_,_,_,_,_).
+magic_info_get_magic_proc_info(Info ^ magic_proc_info, Info, Info).
-magic_info_get_pred_map(PredMap, Info, Info) :-
- Info = magic_info(_,_,_,_,_,_,_,_,_,_,_, PredMap,_,_,_,_,_,_).
+magic_info_get_pred_map(Info ^ pred_map, Info, Info).
-magic_info_get_error_vars(ErrorVars, Info, Info) :-
- Info = magic_info(_,_,_,_,_,_,_,_,_,_,_,_,ErrorVars,_,_,_,_,_).
+magic_info_get_error_vars(Info ^ error_vars, Info, Info).
-magic_info_get_errors(Errors, Info, Info) :-
- Info = magic_info(_,_,_,_,_,_,_,_,_,_,_,_,_,Errors,_,_,_,_).
+magic_info_get_errors(Info ^ errors, Info, Info).
-magic_info_get_ok_types(Types, Info, Info) :-
- Info = magic_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,Types,_,_,_).
+magic_info_get_ok_types(Info ^ ok_types, Info, Info).
-magic_info_get_bad_types(Types, Info, Info) :-
- Info = magic_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,Types,_,_).
+magic_info_get_bad_types(Info ^ bad_types, Info, Info).
%-----------------------------------------------------------------------------%
-magic_info_set_module_info(ModuleInfo, Info0, Info) :-
- Info0 = magic_info(_,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R),
- Info = magic_info(ModuleInfo,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R).
+magic_info_set_module_info(ModuleInfo, Info, Info ^ module_info := ModuleInfo).
-magic_info_set_curr_pred_proc_id(PredProcId, Info0, Info) :-
- Info0 = magic_info(A,_,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R),
- Info = magic_info(A,yes(PredProcId),C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R).
+magic_info_set_error_pred_proc_id(PredProcId, Info0,
+ Info0 ^ error_pred_proc_id := yes(PredProcId)).
-magic_info_set_pred_info(PredInfo, Info0, Info) :-
- Info0 = magic_info(A,B,_,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R),
- Info = magic_info(A,B,yes(PredInfo),D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R).
+magic_info_set_curr_pred_proc_id(PredProcId, Info0,
+ Info0 ^ curr_pred_proc_id := yes(PredProcId)).
-magic_info_set_proc_info(ProcInfo, Info0, Info) :-
- Info0 = magic_info(A,B,C,_,E,F,G,H,I,J,K,L,M,N,O,P,Q,R),
- Info = magic_info(A,B,C,yes(ProcInfo),E,F,G,H,I,J,K,L,M,N,O,P,Q,R).
+magic_info_set_pred_info(PredInfo, Info0, Info0 ^ pred_info := yes(PredInfo)).
-magic_info_set_scc(SCC, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,_,F,G,H,I,J,K,L,M,N,O,P,Q,R),
- Info = magic_info(A,B,C,D,SCC,F,G,H,I,J,K,L,M,N,O,P,Q,R).
+magic_info_set_proc_info(ProcInfo, Info0, Info0 ^ proc_info := yes(ProcInfo)).
-magic_info_set_magic_map(MagicMap, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,E,_,G,H,I,J,K,L,M,N,O,P,Q,R),
- Info = magic_info(A,B,C,D,E,MagicMap,G,H,I,J,K,L,M,N,O,P,Q,R).
+magic_info_set_scc(SCC, Info0, Info0 ^ scc := SCC).
-magic_info_set_magic_vars(Vars, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,E,F,_,H,I,J,K,L,M,N,O,P,Q,R),
- Info = magic_info(A,B,C,D,E,F,Vars,H,I,J,K,L,M,N,O,P,Q,R).
+magic_info_set_magic_map(MagicMap, Info0, Info0 ^ magic_map := MagicMap).
-magic_info_set_magic_insts(Insts, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,E,F,G,_,I,J,K,L,M,N,O,P,Q,R),
- Info = magic_info(A,B,C,D,E,F,G,Insts,I,J,K,L,M,N,O,P,Q,R).
+magic_info_set_magic_vars(Vars, Info0, Info0 ^ magic_vars := Vars).
-magic_info_set_magic_var_map(Map, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,E,F,G,H,_,J,K,L,M,N,O,P,Q,R),
- Info = magic_info(A,B,C,D,E,F,G,H,Map,J,K,L,M,N,O,P,Q,R).
+magic_info_set_magic_var_map(Map, Info0, Info0 ^ magic_var_map := Map).
-magic_info_set_magic_proc_info(MagicProcInfo, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,_,L,M,N,O,P,Q,R),
- Info = magic_info(A,B,C,D,E,F,G,H,I,J,MagicProcInfo,L,M,N,O,P,Q,R).
+magic_info_set_magic_proc_info(MagicProcInfo, Info0,
+ Info0 ^ magic_proc_info := MagicProcInfo).
-magic_info_set_pred_map(PredMap, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,K,_,M,N,O,P,Q,R),
- Info = magic_info(A,B,C,D,E,F,G,H,I,J,K,PredMap,M,N,O,P,Q,R).
+magic_info_set_pred_map(PredMap, Info0, Info0 ^ pred_map := PredMap).
-magic_info_set_error_vars(ErrorVars, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,_,N,O,P,Q,R),
- Info = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,ErrorVars,N,O,P,Q,R).
+magic_info_set_error_vars(ErrorVars, Info0, Info0 ^ error_vars := ErrorVars).
-magic_info_set_errors(Errors, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,_,O,P,Q,R),
- Info = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,Errors,O,P,Q,R).
+magic_info_set_errors(Errors, Info0, Info0 ^ errors := Errors).
-magic_info_set_ok_types(Types, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,_,P,Q,R),
- Info = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,Types,P,Q,R).
+magic_info_set_ok_types(Types, Info0, Info0 ^ ok_types := Types).
-magic_info_set_bad_types(Types, Info0, Info) :-
- Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,_,Q,R),
- Info = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,Types,Q,R).
+magic_info_set_bad_types(Types, Info0, Info0 ^ bad_types := Types).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1610,11 +1650,21 @@
; var_name(string)
.
+:- type rtti_arg
+ ---> type_info
+ ; typeclass_info
+ ; both
+ .
+
:- type magic_error_type
---> argument_error(argument_error, magic_arg_id, pred_proc_id)
% The maybe(int) here is an argument number.
% If there is no argument number the error
% occurred creating a supplementary predicate.
+ ; nonspecific_polymorphism(pred_proc_id, rtti_arg)
+ % There are type-info or typeclass-info
+ % arguments, but there are no polymorphic
+ % arguments.
; curried_argument(pred_proc_id)
% Curried args to an aggregate closure are NYI.
; non_removeable_aditi_state(pred_proc_id,
@@ -1637,6 +1687,7 @@
; higher_order
; abstract
; polymorphic
+ ; existentially_typed
; output_aditi_state
; embedded_aditi_state
.
@@ -1687,13 +1738,21 @@
argument_error(Error, Arg, proc(PredId, _)) - Context) -->
{ error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
- { string__append_list(["In ", PredName, ":"], PredNamePiece) },
+ { string__append_list(["In Aditi ", PredName, ":"], PredNamePiece) },
{ magic_util__error_arg_id_piece(Arg, ArgPiece) },
{ magic_util__report_argument_error(Context, Error, ArgPiece,
Verbose, SecondPart) },
write_error_pieces(Context, 0, [fixed(PredNamePiece), nl | SecondPart]).
magic_util__report_error(ModuleInfo, _Verbose,
+ nonspecific_polymorphism(proc(PredId, _), _) - Context) -->
+ { error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
+ { string__append_list(["In ", PredName, ":"], PredNamePiece) },
+ { SecondPart = [words("the code uses polymorphism or type-classes"),
+ words("which are not supported by Aditi.")] },
+ write_error_pieces(Context, 0, [fixed(PredNamePiece), nl | SecondPart]).
+
+magic_util__report_error(ModuleInfo, _Verbose,
curried_argument(proc(PredId, _)) - Context) -->
{ error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
{ string__append_list(["In ", PredName, ":"], PredNamePiece) },
@@ -1763,7 +1822,8 @@
magic_util__error_arg_id_piece(arg_number(ArgNo), words(ArgWords)) :-
string__int_to_string(ArgNo, ArgStr),
string__append("argument ", ArgStr, ArgWords).
-magic_util__error_arg_id_piece(var_name(Name), words(Name)).
+magic_util__error_arg_id_piece(var_name(Name), words(NameStr)) :-
+ string__append_list(["`", Name, "'"], NameStr).
:- pred magic_util__report_argument_error(term__context::in,
argument_error::in, format_component::in, bool::in,
@@ -1777,6 +1837,10 @@
Pieces = [words("the type of"), ArgPiece, words("is higher order.")].
magic_util__report_argument_error(_Context, polymorphic, ArgPiece, _, Pieces) :-
Pieces = [words("the type of"), ArgPiece, words("is polymorphic.")].
+magic_util__report_argument_error(_Context, existentially_typed,
+ ArgPiece, _, Pieces) :-
+ Pieces = [words("the type of"), ArgPiece,
+ words("contains existentially typed constructors.")].
magic_util__report_argument_error(_Context, abstract, ArgPiece, _, Pieces) :-
Pieces = [words("the type of"), ArgPiece,
words("contains abstract types.")].
Index: compiler//post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.20
diff -u -u -r1.20 post_typecheck.m
--- compiler//post_typecheck.m 2000/05/04 04:33:21 1.20
+++ compiler//post_typecheck.m 2000/05/05 01:51:49
@@ -113,12 +113,12 @@
:- implementation.
:- import_module (assertion), code_util, typecheck, clause_to_proc.
-:- import_module mode_util, inst_match, (inst), prog_util.
+:- import_module mode_util, inst_match, (inst), prog_util, error_util.
:- import_module mercury_to_mercury, prog_out, hlds_out, type_util.
:- import_module globals, options.
:- import_module map, set, assoc_list, bool, std_util, term, require, int.
-:- import_module varset.
+:- import_module string, varset.
%-----------------------------------------------------------------------------%
% Check for unbound type variables
@@ -184,14 +184,8 @@
% the types of some Aditi predicates may not be known before.
%
pred_info_get_markers(PredInfo, Markers),
- pred_info_arg_types(PredInfo, ArgTypes),
- ( check_marker(Markers, aditi) ->
- list__filter(type_is_aditi_state, ArgTypes, AditiStateTypes),
- ( AditiStateTypes = [], ReportErrs = yes ->
- report_no_aditi_state(PredInfo, IOState2, IOState)
- ;
- IOState = IOState2
- )
+ ( ReportErrs = yes, check_marker(Markers, aditi) ->
+ check_aditi_state(ModuleInfo, PredInfo, IOState2, IOState)
;
IOState = IOState2
).
@@ -596,6 +590,17 @@
%
post_typecheck__finish_imported_pred(ModuleInfo, PredId,
PredInfo0, PredInfo) -->
+ { pred_info_get_markers(PredInfo0, Markers) },
+ (
+ { check_marker(Markers, base_relation) },
+ { pred_info_module(PredInfo0, ModuleName) },
+ { module_info_name(ModuleInfo, ModuleName) }
+ ->
+ check_aditi_state(ModuleInfo, PredInfo0)
+ ;
+ []
+ ),
+
% Make sure the var-types field in the clauses_info is
% valid for imported predicates.
% Unification procedures have clauses generated, so
@@ -719,21 +724,114 @@
%-----------------------------------------------------------------------------%
+:- pred check_aditi_state(module_info, pred_info, io__state, io__state).
+:- mode check_aditi_state(in, in, di, uo) is det.
+
+check_aditi_state(ModuleInfo, PredInfo) -->
+ { pred_info_arg_types(PredInfo, ArgTypes) },
+ { list__filter(type_is_aditi_state, ArgTypes, AditiStateTypes) },
+ ( { AditiStateTypes = [] } ->
+ report_no_aditi_state(PredInfo)
+ ;
+ { pred_info_procids(PredInfo, ProcIds) },
+ list__foldl(
+ check_aditi_state_modes(ModuleInfo,
+ PredInfo, ArgTypes),
+ ProcIds)
+ ).
+
+ % If the procedure has declared modes, check that there
+ % is an input `aditi__state' argument.
+:- pred check_aditi_state_modes(module_info, pred_info, list(type),
+ proc_id, io__state, io__state).
+:- mode check_aditi_state_modes(in, in, in, in, di, uo) is det.
+
+check_aditi_state_modes(ModuleInfo, PredInfo, ArgTypes, ProcId) -->
+ { pred_info_procedures(PredInfo, Procs) },
+ { map__lookup(Procs, ProcId, ProcInfo) },
+ { proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) },
+ (
+ { MaybeArgModes = yes(ArgModes) },
+ { AditiUi = aditi_ui_mode },
+ { mode_get_insts(ModuleInfo, AditiUi, AditiUiInitialInst, _) },
+ (
+ { check_aditi_state_modes_2(ModuleInfo, ArgTypes,
+ ArgModes, AditiUiInitialInst) }
+ ->
+ []
+ ;
+ { proc_info_context(ProcInfo, Context) },
+ report_no_input_aditi_state(PredInfo, Context)
+ )
+ ;
+ % XXX Handling procedures for which modes are inferred
+ % is a little tricky, because if the procedure doesn't
+ % directly or indirectly call any base relations, a mode
+ % of `unused' for the `aditi__state' argument may be inferred.
+ % In the worst case, a runtime error will be reported
+ % if the predicate is called outside of a transaction.
+ { MaybeArgModes = no }
+ ).
+
+:- pred check_aditi_state_modes_2(module_info, list(type), list(mode), (inst)).
+:- mode check_aditi_state_modes_2(in, in, in, in) is semidet.
+
+check_aditi_state_modes_2(ModuleInfo, [Type | Types], [Mode | Modes],
+ InitialAditiStateInst) :-
+ (
+ type_is_aditi_state(Type),
+ mode_get_insts(ModuleInfo, Mode, InitialInst, _),
+ % Mode analysis will check the final inst.
+ inst_matches_initial(InitialInst, InitialAditiStateInst,
+ ModuleInfo)
+ ;
+ check_aditi_state_modes_2(ModuleInfo, Types, Modes,
+ InitialAditiStateInst)
+ ).
+
:- pred report_no_aditi_state(pred_info, io__state, io__state).
:- mode report_no_aditi_state(in, di, uo) is det.
report_no_aditi_state(PredInfo) -->
io__set_exit_status(1),
{ pred_info_context(PredInfo, Context) },
- prog_out__write_context(Context),
- { pred_info_module(PredInfo, Module) },
- { pred_info_name(PredInfo, Name) },
- { pred_info_arity(PredInfo, Arity) },
- { pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
- io__write_string("Error: `:- pragma aditi' declaration for "),
- hlds_out__write_simple_call_id(PredOrFunc,
- qualified(Module, Name), Arity),
- io__write_string(" without an `aditi:state' argument.\n").
+ { report_aditi_pragma(PredInfo, PredErrorPieces) },
+ { list__append(PredErrorPieces,
+ [words("without an `aditi__state' argument.")], ErrorPieces) },
+ error_util__write_error_pieces(Context, 0, ErrorPieces).
+
+:- pred report_no_input_aditi_state(pred_info, prog_context,
+ io__state, io__state).
+:- mode report_no_input_aditi_state(in, in, di, uo) is det.
+
+report_no_input_aditi_state(PredInfo, Context) -->
+ io__set_exit_status(1),
+ { report_aditi_pragma(PredInfo, PredErrorPieces) },
+ { list__append(PredErrorPieces,
+ [words(
+ "without an `aditi__state' argument with mode `aditi_ui'.")],
+ ErrorPieces) },
+ error_util__write_error_pieces(Context, 0, ErrorPieces).
+
+:- pred report_aditi_pragma(pred_info, list(format_component)).
+:- mode report_aditi_pragma(in, out) is det.
+
+report_aditi_pragma(PredInfo, ErrorPieces) :-
+ pred_info_module(PredInfo, Module),
+ pred_info_name(PredInfo, Name),
+ pred_info_arity(PredInfo, Arity),
+ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
+ pred_info_get_markers(PredInfo, Markers),
+ ( check_marker(Markers, base_relation) ->
+ Pragma = "base_relation"
+ ;
+ Pragma = "aditi"
+ ),
+ string__append_list(["`:- pragma ", Pragma, "'"], PragmaStr),
+ CallId = PredOrFunc - qualified(Module, Name)/Arity,
+ hlds_out__simple_call_id_to_string(CallId, CallIdStr),
+ ErrorPieces = [fixed("Error:"), fixed(PragmaStr),
+ words("declaration for"), fixed(CallIdStr)].
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.62
diff -u -u -r1.62 Mmakefile
--- tests/invalid/Mmakefile 2000/04/22 07:12:40 1.62
+++ tests/invalid/Mmakefile 2000/05/05 01:18:07
@@ -11,6 +11,8 @@
# also need to be listed below, in the .depend list, as well as here.
SOURCES= \
+ aditi_errors.m \
+ aditi_state_errors.m \
aditi_update_errors.m \
aditi_update_mode_errors.m \
any_mode.m \
@@ -94,11 +96,13 @@
# the type class name should be in quotes;
# also a software_error)
+MCFLAGS-aditi_errors = --aditi
+MCFLAGS-aditi_state_errors = --aditi
MCFLAGS-aditi_update_errors = --aditi
MCFLAGS-aditi_update_mode_errors = --aditi
MCFLAGS-any_mode = --infer-types
MCFLAGS-duplicate_modes = --verbose-error-messages
-MCFLAGS-missing_det_decls = --no-infer-det
+MCFLAGS-missing_det_decls = --no-infer-det
MCFLAGS-missing_interface_import = --make-interface
MCFLAGS-multisoln_func = --infer-types
MCFLAGS-no_exports = --halt-at-warn
Index: tests/invalid/aditi_errors.err_exp
===================================================================
RCS file: aditi_errors.err_exp
diff -N aditi_errors.err_exp
--- /dev/null Fri May 5 12:34:41 2000
+++ aditi_errors.err_exp Fri May 5 12:37:26 2000
@@ -0,0 +1,16 @@
+aditi_errors.m:021: In Aditi predicate `aditi_errors:q/4':
+aditi_errors.m:021: argument 4 is partially instantiated.
+aditi_errors.m:040: In Aditi predicate `aditi_errors:aditi_error/5':
+aditi_errors.m:040: `HeadVar__4' is partially instantiated.
+aditi_errors.m:008: In Aditi predicate `aditi_errors:aditi_error/5':
+aditi_errors.m:008: the type of argument 5 contains abstract types.
+aditi_errors.m:040: In Aditi predicate `aditi_errors:aditi_error/5':
+aditi_errors.m:040: the type of `HeadVar__5' contains abstract types.
+aditi_errors.m:021: In Aditi predicate `aditi_errors:q/4':
+aditi_errors.m:021: the type of argument 2 is polymorphic.
+aditi_errors.m:021: In Aditi predicate `aditi_errors:q/4':
+aditi_errors.m:021: the type of argument 4 is polymorphic.
+aditi_errors.m:021: In Aditi predicate `aditi_errors:q/4':
+aditi_errors.m:021: the type of argument 3 contains existentially typed
+aditi_errors.m:021: constructors.
+For more information, try recompiling with `-E'.
Index: tests/invalid/aditi_errors.m
===================================================================
RCS file: aditi_errors.m
diff -N aditi_errors.m
--- /dev/null Fri May 5 12:34:41 2000
+++ aditi_errors.m Fri May 5 12:37:15 2000
@@ -0,0 +1,42 @@
+:- module aditi_errors.
+
+:- interface.
+
+:- import_module aditi.
+:- import_module list, map.
+
+:- pred aditi_error(aditi__state::aditi_ui,
+ int::out, int::out, foo::out, map(int, int)::in) is nondet.
+:- pragma aditi(aditi_error/5).
+
+:- type foo
+ ---> foo(int).
+
+:- type existq
+ ---> some [T] existq(T).
+
+:- pred p(aditi__state::aditi_ui, int::out, int::out) is nondet.
+:- pragma base_relation(p/3).
+
+:- pred q(aditi__state::aditi_ui, list(T)::in, existq::out,
+ list(T)::out(list_skel(free))) is nondet.
+:- pragma base_relation(q/4).
+
+/*
+ % Class constraints of the form used in this example
+ % are not yet implemented.
+
+:- pred tclass(aditi__state, int, list(int)) <= class(int).
+:- mode tclass(aditi_ui, out, out) is nondet.
+:- pragma base_relation(tclass/4).
+
+:- typeclass class(T) where [].
+*/
+
+:- implementation.
+
+aditi_error(DB, A, B, Thing, _) :-
+ Thing = foo(_),
+ p(DB, A, B),
+ Thing = foo(A).
+
Index: tests/invalid/aditi_state_errors.err_exp
===================================================================
RCS file: aditi_state_errors.err_exp
diff -N aditi_state_errors.err_exp
--- /dev/null Fri May 5 12:34:41 2000
+++ aditi_state_errors.err_exp Fri May 5 11:56:19 2000
@@ -0,0 +1,8 @@
+aditi_state_errors.m:007: Error: `:- pragma base_relation' declaration for
+aditi_state_errors.m:007: predicate `aditi_state_errors:no_aditi_state/2'
+aditi_state_errors.m:007: without an `aditi__state' argument.
+aditi_state_errors.m:010: Error: `:- pragma base_relation' declaration for
+aditi_state_errors.m:010: predicate `aditi_state_errors:output_aditi_state/3'
+aditi_state_errors.m:010: without an `aditi__state' argument with mode
+aditi_state_errors.m:010: `aditi_ui'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/aditi_state_errors.m
===================================================================
RCS file: aditi_state_errors.m
diff -N aditi_state_errors.m
--- /dev/null Fri May 5 12:34:41 2000
+++ aditi_state_errors.m Fri May 5 11:18:50 2000
@@ -0,0 +1,12 @@
+:- module aditi_state_errors.
+
+:- interface.
+
+:- import_module aditi.
+
+:- pred no_aditi_state(int::out, int::out) is det.
+:- pragma base_relation(no_aditi_state/2).
+
+:- pred output_aditi_state(aditi__state::out, int::out, int::out) is det.
+:- pragma base_relation(output_aditi_state/3).
+
--------------------------------------------------------------------------
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