[m-rev.] for review: fix handling of transitive module imports
Simon Taylor
stayl at cs.mu.OZ.AU
Wed May 2 17:57:47 AEST 2001
Estimated hours taken: 8
Fix a bug in the module import mechanism -- use_module should
not be transitive. This change is needed for smart recompilation
to avoid needing to check whether the removal of a transitive
import could cause compilation errors -- it never should.
compiler/prog_data.m:
Add a `transitively_imported' pseudo-declaration, which
is placed before the items from `.int2' files and `.opt'
files.
Fix the representation of type class bodies.
`:- typeclass foo where [].' declares a typeclass with no
methods. `:- typeclass foo.' declares an abstract typeclass.
The old representation made no distinction between these cases.
compiler/hlds_data.m:
compiler/prog_data.m:
compiler/module_qual.m:
Move the declaration of type type_id from hlds_data.m to prog_data.m.
This avoids a duplicate declaration in module_qual.m.
compiler/modules.m:
Add a `transitively_imported' pseudo-declaration before the
items from `.int2' files.
Remove the bodies of typeclass declarations placed in `.int2'
files -- the methods should not be available unless the module
is explicitly imported.
compiler/module_qual.m:
Items after the `transitively_imported' pseudo-declaration
should not be considered when module qualifying locally
declared items.
compiler/equiv_type.m:
compiler/mercury_to_mercury.m:
compiler/prog_io_typeclass.m:
Handle the change to the representation of typeclass bodies.
compiler/prog_io_typeclass.m:
Check that the arguments of a typeclass declaration
are distinct variables.
compiler/make_hlds.m:
Handle abstract typeclass declarations.
compiler/check_typeclass.m:
Check that all typeclasses have a definition somewhere.
compiler/intermod.m:
Write abstract_exported typeclasses to the `.opt' file.
compiler/add_trail_ops.m:
compiler/context.m:
compiler/llds.m:
compiler/vn_type.m:
Add missing imports.
compiler/magic_util.m:
compiler/ml_type_gen.m:
Remove unnecessary imports.
NEWS:
Note that this change may break existing programs.
compiler/notes/todo.html:
Remove the item relating to this change.
tests/invalid/transitive_import.{m,err_exp}:
Add some tests for uses of transitively imported items.
tests/invalid/transitive_import_class.m:
tests/invalid/transitive_import_class2.m:
tests/invalid/transitive_import_class3.m:
tests/invalid/transitive_import_class.err_exp:
Add a test for use of transitively imported class methods.
tests/invalid/invalid_typeclass.{m,err_exp}:
Add some tests for invalid typeclass declarations.
tests/invalid/Mmakefile:
Add the new tests.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.206
diff -u -u -r1.206 NEWS
--- NEWS 2001/03/27 05:23:01 1.206
+++ NEWS 2001/05/02 05:44:40
@@ -15,6 +15,15 @@
* The exception module has a new predicate `try_store', which is
like `try_io', but which works with stores rather than io__states.
+Changes to the Mercury implementation:
+* We've fixed a bug in the handling of module imports. Previously,
+ if `module1' imported `module2' which imported `module3' in
+ its interface section, types, insts, modes and typeclasses defined
+ in the interface of `module3' could be used in `module1' even
+ if `module1' did not import `module3' directly.
+
+ This change will break some existing programs, but that is easily fixed
+ by adding any necessary `:- import_module' or `:- use_module' declarations.
NEWS for Mercury release 0.10.1:
--------------------------------
Index: compiler/add_trail_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_trail_ops.m,v
retrieving revision 1.3
diff -u -u -r1.3 add_trail_ops.m
--- compiler/add_trail_ops.m 2001/04/07 14:04:30 1.3
+++ compiler/add_trail_ops.m 2001/05/01 06:48:05
@@ -40,7 +40,7 @@
:- import_module code_model, instmap.
:- import_module bool, string.
-:- import_module assoc_list, list, map, set, varset, std_util, require.
+:- import_module assoc_list, list, map, set, varset, std_util, require, term.
%
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.40
diff -u -u -r1.40 check_typeclass.m
--- compiler/check_typeclass.m 2001/04/29 07:54:18 1.40
+++ compiler/check_typeclass.m 2001/05/02 07:23:42
@@ -104,7 +104,11 @@
).
:- type check_tc_info
- ---> check_tc_info(error_messages, module_info, qual_info).
+ ---> check_tc_info(
+ error_messages :: error_messages,
+ module_info :: module_info,
+ qual_info :: qual_info
+ ).
% list__map_foldl2(Pred, InList, OutList, StartA, EndA, StartB, EndB)
% calls Pred with two accumulator (with the initial values of
@@ -134,53 +138,91 @@
ClassId - InstanceDefns, CheckTCInfo0, CheckTCInfo, IO0, IO) :-
map__lookup(ClassTable, ClassId, ClassDefn),
- ClassDefn = hlds_class_defn(_, SuperClasses, ClassVars, _,
- ClassInterface, ClassVarSet, _TermContext),
- solutions(
- lambda([PredId::out] is nondet,
- (
+ ClassDefn = hlds_class_defn(ImportStatus, SuperClasses, ClassVars,
+ Interface, ClassInterface, ClassVarSet, TermContext),
+
+ (
+ status_defined_in_this_module(ImportStatus, yes),
+ Interface = abstract
+ ->
+ ClassId = class_id(ClassName, ClassArity),
+ sym_name_and_arity_to_string(ClassName / ClassArity,
+ ClassNameStr),
+ ErrorPieces = [
+ words("Error: no definition for typeclass"),
+ words(string__append_list(["`", ClassNameStr, "'."]))
+ ],
+
+ Messages0 = CheckTCInfo0 ^ error_messages,
+ CheckTCInfo = CheckTCInfo0 ^ error_messages :=
+ [TermContext - ErrorPieces | Messages0],
+ InstanceDefns = InstanceDefns0,
+ IO = IO0
+ ;
+ solutions(
+ (pred(PredId::out) is nondet :-
list__member(ClassProc, ClassInterface),
ClassProc = hlds_class_proc(PredId, _)
- )),
- PredIds),
- list_map_foldl2(check_class_instance(ClassId, SuperClasses, ClassVars,
- ClassInterface, ClassVarSet,
- PredIds),
- InstanceDefns0, InstanceDefns,
- CheckTCInfo0, CheckTCInfo,
- IO0, IO).
+ ),
+ PredIds),
+ list_map_foldl2(
+ check_class_instance(ClassId, SuperClasses,
+ ClassVars, ClassInterface, Interface,
+ ClassVarSet, PredIds),
+ InstanceDefns0, InstanceDefns,
+ CheckTCInfo0, CheckTCInfo,
+ IO0, IO)
+ ).
% check one instance of one class
:- pred check_class_instance(class_id, list(class_constraint), list(tvar),
- hlds_class_interface, tvarset, list(pred_id),
+ hlds_class_interface, class_interface, tvarset, list(pred_id),
hlds_instance_defn, hlds_instance_defn,
check_tc_info, check_tc_info,
io__state, io__state).
-:- mode check_class_instance(in, in, in, in, in, in, in, out, in, out,
+:- mode check_class_instance(in, in, in, in, in, in, in, in, out, in, out,
di, uo) is det.
-check_class_instance(ClassId, SuperClasses, Vars, ClassInterface, ClassVarSet,
- PredIds, InstanceDefn0, InstanceDefn,
+check_class_instance(ClassId, SuperClasses, Vars, HLDSClassInterface,
+ ClassInterface, ClassVarSet, PredIds, InstanceDefn0,
+ InstanceDefn,
check_tc_info(Errors0, ModuleInfo0, QualInfo0),
check_tc_info(Errors, ModuleInfo, QualInfo),
IO0, IO):-
% check conformance of the instance body
- InstanceDefn0 = hlds_instance_defn(_, _, _, _, _, InstanceBody,
- _, _, _),
+ InstanceDefn0 = hlds_instance_defn(_, _, TermContext, _, _,
+ InstanceBody, _, _, _),
(
- InstanceBody = abstract,
+ InstanceBody = abstract,
+ InstanceDefn2 = InstanceDefn0,
+ ModuleInfo1 = ModuleInfo0,
+ QualInfo = QualInfo0,
+ Errors2 = Errors0,
+ IO = IO0
+ ;
+ InstanceBody = concrete(InstanceMethods),
+ (
+ ClassInterface = abstract,
+ ClassId = class_id(ClassName, ClassArity),
+ sym_name_and_arity_to_string(ClassName / ClassArity,
+ ClassNameStr),
+ ErrorPieces = [
+ words("Error: instance declaration for"),
+ words("abstract typeclass"),
+ words(string__append_list(["`", ClassNameStr, "'."]))
+ ],
+ Errors2 = [TermContext - ErrorPieces | Errors0],
InstanceDefn2 = InstanceDefn0,
ModuleInfo1 = ModuleInfo0,
QualInfo = QualInfo0,
- Errors2 = Errors0,
IO = IO0
- ;
- InstanceBody = concrete(InstanceMethods),
+ ;
+ ClassInterface = concrete(_),
InstanceCheckInfo0 = instance_check_info(InstanceDefn0,
[], Errors0, ModuleInfo0, QualInfo0),
list__foldl2(
- check_instance_pred(ClassId, Vars, ClassInterface),
+ check_instance_pred(ClassId, Vars, HLDSClassInterface),
PredIds, InstanceCheckInfo0, InstanceCheckInfo,
IO0, IO),
InstanceCheckInfo = instance_check_info(InstanceDefn1,
@@ -222,6 +264,7 @@
_, _, _, _, _, _),
check_for_bogus_methods(InstanceMethods, ClassId, PredIds,
Context, ModuleInfo1, Errors1, Errors2)
+ )
),
% check that the superclass constraints are satisfied for the
@@ -687,16 +730,16 @@
module_info_globals(ModuleInfo0, Globals),
globals__lookup_string_option(Globals, aditi_user, User),
- adjust_func_arity(PredOrFunc, Arity, PredArity),
- produce_instance_method_clauses(InstancePredDefn, PredOrFunc,
- PredArity, ArgTypes, Markers, Context, ClausesInfo,
- ModuleInfo0, ModuleInfo1, QualInfo0, QualInfo, IO0, IO),
-
( status_is_imported(Status0, yes) ->
Status = opt_imported
;
Status = Status0
),
+
+ adjust_func_arity(PredOrFunc, Arity, PredArity),
+ produce_instance_method_clauses(InstancePredDefn, PredOrFunc,
+ PredArity, ArgTypes, Markers, Context, Status, ClausesInfo,
+ ModuleInfo0, ModuleInfo1, QualInfo0, QualInfo, IO0, IO),
pred_info_init(ModuleName, PredName, PredArity, ArgTypeVars,
ExistQVars, ArgTypes, Cond, Context, ClausesInfo, Status,
Index: compiler/context.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/context.m,v
retrieving revision 1.3
diff -u -u -r1.3 context.m
--- compiler/context.m 2000/04/14 08:37:46 1.3
+++ compiler/context.m 2001/05/01 06:48:05
@@ -49,7 +49,7 @@
:- import_module hlds_data, hlds_module, (inst), instmap.
:- import_module goal_util.
-:- import_module assoc_list, bool, map, require, set, std_util, varset.
+:- import_module assoc_list, bool, map, require, set, std_util, term, varset.
context__process_disjuncts(OldPredProcId, Inputs, Outputs,
Disjuncts0, Disjuncts) -->
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.24
diff -u -u -r1.24 equiv_type.m
--- compiler/equiv_type.m 2000/11/25 10:41:54 1.24
+++ compiler/equiv_type.m 2001/05/02 05:43:13
@@ -157,8 +157,15 @@
no) :-
equiv_type__replace_in_class_constraint_list(Constraints0, VarSet0,
EqvMap, Constraints, VarSet),
- equiv_type__replace_in_class_interface(ClassInterface0,
- EqvMap, ClassInterface).
+ (
+ ClassInterface0 = abstract,
+ ClassInterface = abstract
+ ;
+ ClassInterface0 = concrete(Methods0),
+ equiv_type__replace_in_class_interface(Methods0,
+ EqvMap, Methods),
+ ClassInterface = concrete(Methods)
+ ).
equiv_type__replace_in_item(
instance(Constraints0, ClassName, Ts0,
@@ -238,8 +245,8 @@
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_class_interface(class_interface,
- eqv_map, class_interface).
+:- pred equiv_type__replace_in_class_interface(list(class_method),
+ eqv_map, list(class_method)).
:- mode equiv_type__replace_in_class_interface(in, in, out) is det.
equiv_type__replace_in_class_interface(ClassInterface0, EqvMap,
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.53
diff -u -u -r1.53 hlds_data.m
--- compiler/hlds_data.m 2001/03/01 12:52:48 1.53
+++ compiler/hlds_data.m 2001/05/01 07:18:36
@@ -234,9 +234,6 @@
% The symbol table for types.
-:- type type_id == pair(sym_name, arity).
- % name, arity
-
:- type type_table == map(type_id, hlds_type_defn).
% This is how type, modes and constructors are represented.
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.98
diff -u -u -r1.98 intermod.m
--- compiler/intermod.m 2001/04/18 07:29:31 1.98
+++ compiler/intermod.m 2001/05/02 05:35:02
@@ -1345,7 +1345,9 @@
{ ClassId = class_id(QualifiedClassName, _) },
(
{ QualifiedClassName = qualified(ModuleName, _) },
- { ImportStatus = local }
+ { ImportStatus = local
+ ; ImportStatus = abstract_exported
+ }
->
{ Item = typeclass(Constraints, QualifiedClassName, TVars,
Interface, TVarSet) },
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.275
diff -u -u -r1.275 llds.m
--- compiler/llds.m 2001/04/24 03:58:56 1.275
+++ compiler/llds.m 2001/05/01 06:48:05
@@ -21,7 +21,7 @@
:- import_module code_model, rtti, layout, builtin_ops.
:- import_module tree.
-:- import_module bool, assoc_list, list, map, set, std_util, counter.
+:- import_module bool, assoc_list, list, map, set, std_util, counter, term.
%-----------------------------------------------------------------------------%
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.12
diff -u -u -r1.12 magic_util.m
--- compiler/magic_util.m 2000/10/13 13:55:33 1.12
+++ compiler/magic_util.m 2001/05/01 06:48:05
@@ -14,7 +14,7 @@
:- interface.
-:- import_module hlds_data, hlds_goal, hlds_module, hlds_pred, prog_data.
+:- import_module hlds_goal, hlds_module, hlds_pred, prog_data.
:- import_module bool, io, list, map, set, std_util.
% Check that the argument types and modes are legal for
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.369
diff -u -u -r1.369 make_hlds.m
--- compiler/make_hlds.m 2001/04/29 07:54:18 1.369
+++ compiler/make_hlds.m 2001/05/02 02:47:57
@@ -77,7 +77,7 @@
% for that definition.
:- pred produce_instance_method_clauses(instance_proc_def::in,
pred_or_func::in, arity::in, list(type)::in, pred_markers::in,
- term__context::in, clauses_info::out,
+ term__context::in, import_status::in, clauses_info::out,
module_info::in, module_info::out,
qual_info::in, qual_info::out,
io__state::di, io__state::uo) is det.
@@ -316,6 +316,9 @@
report_unexpected_decl("end_module", Context),
{ Status = Status0 },
{ Module = Module0 }
+ ; { ModuleDefn = transitively_imported } ->
+ { Status = Status0 },
+ { Module = Module0 }
;
{ Status = Status0 },
{ Module = Module0 },
@@ -2305,73 +2308,154 @@
{ module_info_superclasses(Module0, SuperClasses0) },
{ list__length(Vars, ClassArity) },
{ ClassId = class_id(Name, ClassArity) },
- { Status = item_status(ImportStatus, _) },
- (
- { map__search(Classes0, ClassId, OldValue) }
+ { Status = item_status(ImportStatus0, _) },
+ { Interface = abstract ->
+ make_status_abstract(ImportStatus0, ImportStatus1)
+ ;
+ ImportStatus1 = ImportStatus0
+ },
+ (
+ % the typeclass is exported if *any* occurrence is exported,
+ % even a previous abstract occurrence
+ { map__search(Classes0, ClassId, OldDefn) }
->
- { Module = Module0 },
- ( { ImportStatus \= opt_imported } ->
- { OldValue = hlds_class_defn(_, _, _, _, _, _,
- OldContext) },
- multiple_def_error(Name, ClassArity, "typeclass",
- Context, OldContext),
- io__set_exit_status(1)
+ { OldDefn = hlds_class_defn(OldStatus, OldConstraints,
+ OldVars, OldInterface, OldMethods,
+ OldVarSet, OldContext) },
+ { combine_status(ImportStatus1, OldStatus, ImportStatus) },
+ {
+ OldInterface = concrete(_),
+ ClassMethods0 = OldMethods,
+ ClassInterface = OldInterface
+ ;
+ OldInterface = abstract,
+ ClassMethods0 = [],
+ ClassInterface = Interface
+ },
+ (
+ \+ { superclass_constraints_are_identical(OldVars,
+ OldVarSet, OldConstraints, Vars, VarSet,
+ Constraints) }
+ ->
+ multiple_def_error(Name, ClassArity,
+ "typeclass", Context, OldContext),
+ prog_out__write_context(Context),
+ io__write_string(
+ " The superclass constraints do not match.\n"),
+ io__set_exit_status(1),
+ { FoundError = yes }
;
- []
- )
- ;
- module_add_class_interface(Module0, Name, Vars, Interface,
- Status, PredProcIds0, Module1),
- % Get rid of the `no's from the list of maybes
- { IsYes = lambda([Maybe::in, PredProcId::out] is semidet,
- (
- Maybe = yes(Pred - Proc),
- PredProcId = hlds_class_proc(Pred, Proc)
- )) },
- { list__filter_map(IsYes, PredProcIds0, PredProcIds1) },
+ { Interface = concrete(_) },
+ { OldInterface = concrete(_) }
+ ->
+ { FoundError = yes },
+ ( { ImportStatus = opt_imported } ->
+ []
+ ;
+ multiple_def_error(Name, ClassArity,
+ "typeclass", Context, OldContext),
+ io__set_exit_status(1)
+ )
+ ;
+ { FoundError = no }
+ ),
- %
- % The list must be sorted on pred_id and then
- % proc_id -- check_typeclass.m assumes this
- % when it is generating the corresponding list
- % of pred_proc_ids for instance definitions.
- %
- { list__sort(PredProcIds1, PredProcIds) },
+ { IsNewDefn = no }
+ ;
+ { IsNewDefn = yes `with_type` bool },
+ { FoundError = no `with_type` bool },
+ { ClassMethods0 = [] },
+ { ClassInterface = Interface },
+ { ImportStatus = ImportStatus1 }
+ ),
+ ( { FoundError = no } ->
+ (
+ { Interface = concrete(Methods) },
+ module_add_class_interface(Module0, Name, Vars,
+ Methods, Status, PredProcIds0, Module1),
+ % Get rid of the `no's from the list of maybes
+ { IsYes =
+ (pred(Maybe::in, PredProcId::out) is semidet :-
+ (
+ Maybe = yes(Pred - Proc),
+ PredProcId = hlds_class_proc(Pred, Proc)
+ )) },
+ { list__filter_map(IsYes, PredProcIds0, PredProcIds1) },
+
+ %
+ % The list must be sorted on pred_id and then
+ % proc_id -- check_typeclass.m assumes this
+ % when it is generating the corresponding list
+ % of pred_proc_ids for instance definitions.
+ %
+ { list__sort(PredProcIds1, ClassMethods) }
+ ;
+ { Interface = abstract },
+ { ClassMethods = ClassMethods0 },
+ { Module1 = Module0 }
+ ),
- { Value = hlds_class_defn(ImportStatus, Constraints,
- Vars, Interface, PredProcIds, VarSet, Context) },
- { map__det_insert(Classes0, ClassId, Value, Classes) },
+ { Defn = hlds_class_defn(ImportStatus, Constraints, Vars,
+ ClassInterface, ClassMethods, VarSet, Context) },
+ { map__set(Classes0, ClassId, Defn, Classes) },
{ module_info_set_classes(Module1, Classes, Module2) },
-
- % insert an entry into the super class table for each
- % super class of this class
- { AddSuper = lambda([Super::in, Ss0::in, Ss::out] is det,
- (
- Super = constraint(SuperName, SuperTypes),
- list__length(SuperTypes, SuperClassArity),
- term__vars_list(SuperTypes, SuperVars),
- SuperClassId = class_id(SuperName,
- SuperClassArity),
- SubClassDetails = subclass_details(SuperVars,
- ClassId, Vars, VarSet),
- multi_map__set(Ss0, SuperClassId,
- SubClassDetails, Ss)
- )) },
- { list__foldl(AddSuper, Constraints,
- SuperClasses0, SuperClasses) },
- { module_info_set_superclasses(Module2,
- SuperClasses, Module3) },
-
- % When we find the class declaration, make an
- % entry for the instances.
- { module_info_instances(Module3, Instances0) },
- { map__det_insert(Instances0, ClassId, [], Instances) },
- { module_info_set_instances(Module3, Instances, Module) }
+ ( { IsNewDefn = yes } ->
+ % insert an entry into the super class table
+ % for each super class of this class
+ { AddSuper =
+ (pred(Super::in, Ss0::in, Ss::out) is det :-
+ (
+ Super = constraint(SuperName,
+ SuperTypes),
+ list__length(SuperTypes,
+ SuperClassArity),
+ term__vars_list(SuperTypes, SuperVars),
+ SuperClassId = class_id(SuperName,
+ SuperClassArity),
+ SubClassDetails =
+ subclass_details(SuperVars,
+ ClassId, Vars, VarSet),
+ multi_map__set(Ss0, SuperClassId,
+ SubClassDetails, Ss)
+ )
+ ) },
+ { list__foldl(AddSuper, Constraints,
+ SuperClasses0, SuperClasses) },
+
+ { module_info_set_superclasses(Module2,
+ SuperClasses, Module3) },
+
+ % When we find the class declaration, make an
+ % entry for the instances.
+ { module_info_instances(Module3, Instances0) },
+ { map__det_insert(Instances0, ClassId, [], Instances) },
+ { module_info_set_instances(Module3,
+ Instances, Module) }
+ ;
+ { Module = Module2 }
+ )
+ ;
+ { Module = Module0 }
).
+:- pred superclass_constraints_are_identical(list(tvar), tvarset,
+ list(class_constraint), list(tvar), tvarset, list(class_constraint)).
+:- mode superclass_constraints_are_identical(in, in,
+ in, in, in, in) is semidet.
+
+superclass_constraints_are_identical(OldVars, OldVarSet, OldConstraints0,
+ Vars, VarSet, Constraints) :-
+ varset__merge_subst(VarSet, OldVarSet, _, Subst),
+ apply_subst_to_constraint_list(Subst,
+ OldConstraints0, OldConstraints1),
+ map__from_corresponding_lists(OldVars, Vars, VarRenaming),
+ apply_variable_renaming_to_constraint_list(VarRenaming,
+ OldConstraints1, OldConstraints),
+ OldConstraints = Constraints.
+
:- pred module_add_class_interface(module_info, sym_name, list(tvar),
- class_interface, item_status, list(maybe(pair(pred_id, proc_id))),
+ list(class_method), item_status, list(maybe(pair(pred_id, proc_id))),
module_info, io__state, io__state).
:- mode module_add_class_interface(in, in, in, in, in, out, out, di, uo) is det.
@@ -2383,7 +2467,7 @@
PredProcIds, Module1, Module).
:- pred module_add_class_interface_2(module_info, sym_name, list(tvar),
- class_interface, item_status, list(maybe(pair(pred_id, proc_id))),
+ list(class_method), item_status, list(maybe(pair(pred_id, proc_id))),
module_info, io__state, io__state).
:- mode module_add_class_interface_2(in, in, in, in, in, out, out,
di, uo) is det.
@@ -2455,7 +2539,7 @@
% - functions without mode declarations: add a default mode
% - predicates without mode declarations: report an error
% - mode declarations with no determinism: report an error
-:- pred check_method_modes(class_interface,
+:- pred check_method_modes(list(class_method),
list(maybe(pair(pred_id, proc_id))),
list(maybe(pair(pred_id, proc_id))), module_info, module_info,
io__state, io__state).
@@ -3635,7 +3719,7 @@
{ pred_info_all_procids(PredInfo2, ProcIds) },
clauses_info_add_clause(Clauses0, ProcIds,
ClauseVarSet, TVarSet0, Args, Body, Context,
- PredOrFunc, Arity, IsAssertion, Goal,
+ Status, PredOrFunc, Arity, IsAssertion, Goal,
VarSet, TVarSet, Clauses, Warnings,
ModuleInfo1, ModuleInfo2, Info0, Info),
{
@@ -3690,7 +3774,7 @@
% handle the `pred(<MethodName>/<Arity>) is <ImplName>' syntax
produce_instance_method_clauses(name(InstancePredName), PredOrFunc, PredArity,
- ArgTypes, Markers, Context, ClausesInfo,
+ ArgTypes, Markers, Context, _Status, ClausesInfo,
ModuleInfo, ModuleInfo, QualInfo, QualInfo, IO, IO) :-
% Add the body of the introduced pred
@@ -3729,19 +3813,20 @@
% handle the arbitrary clauses syntax
produce_instance_method_clauses(clauses(InstanceClauses), PredOrFunc,
- PredArity, _ArgTypes, _Markers, Context, ClausesInfo,
+ PredArity, _ArgTypes, _Markers, Context, Status, ClausesInfo,
ModuleInfo0, ModuleInfo, QualInfo0, QualInfo, IO0, IO) :-
clauses_info_init(PredArity, ClausesInfo0),
- list__foldl2(produce_instance_method_clause(PredOrFunc, Context),
+ list__foldl2(
+ produce_instance_method_clause(PredOrFunc, Context, Status),
InstanceClauses, ModuleInfo0 - QualInfo0 - ClausesInfo0,
ModuleInfo - QualInfo - ClausesInfo, IO0, IO).
:- pred produce_instance_method_clause(pred_or_func::in,
- prog_context::in, item::in,
+ prog_context::in, import_status::in, item::in,
pair(pair(module_info, qual_info), clauses_info)::in,
pair(pair(module_info, qual_info), clauses_info)::out,
io__state::di, io__state::uo) is det.
-produce_instance_method_clause(PredOrFunc, Context, InstanceClause,
+produce_instance_method_clause(PredOrFunc, Context, Status, InstanceClause,
ModuleInfo0 - QualInfo0 - ClausesInfo0,
ModuleInfo - QualInfo - ClausesInfo) -->
(
@@ -3767,7 +3852,7 @@
% mode of the procedure
{ IsAssertion = no },
clauses_info_add_clause(ClausesInfo0, ProcIds,
- CVarSet, TVarSet0, HeadTerms, Body, Context,
+ CVarSet, TVarSet0, HeadTerms, Body, Context, Status,
PredOrFunc, Arity, IsAssertion, Goal,
VarSet, _TVarSet, ClausesInfo, Warnings,
ModuleInfo0, ModuleInfo, QualInfo0, QualInfo),
@@ -5022,15 +5107,15 @@
:- pred clauses_info_add_clause(clauses_info::in,
list(proc_id)::in, prog_varset::in, tvarset::in,
list(prog_term)::in, goal::in, prog_context::in,
- pred_or_func::in, arity::in, bool::in,
+ import_status::in, pred_or_func::in, arity::in, bool::in,
hlds_goal::out, prog_varset::out, tvarset::out,
clauses_info::out, list(quant_warning)::out,
module_info::in, module_info::out, qual_info::in,
qual_info::out, io__state::di, io__state::uo) is det.
clauses_info_add_clause(ClausesInfo0, ModeIds, CVarSet, TVarSet0,
- Args, Body, Context, PredOrFunc, Arity, IsAssertion, Goal,
- VarSet, TVarSet, ClausesInfo, Warnings, Module0, Module,
+ Args, Body, Context, Status, PredOrFunc, Arity, IsAssertion,
+ Goal, VarSet, TVarSet, ClausesInfo, Warnings, Module0, Module,
Info0, Info) -->
{ ClausesInfo0 = clauses_info(VarSet0, ExplicitVarTypes0, TVarNameMap0,
InferredVarTypes, HeadVars, ClauseList0,
@@ -5048,7 +5133,7 @@
TVarNameMap = TVarNameMap0
},
{ update_qual_info(Info0, TVarNameMap, TVarSet0,
- ExplicitVarTypes0, Info1) },
+ ExplicitVarTypes0, Status, Info1) },
{ varset__merge_subst(VarSet0, CVarSet, VarSet1, Subst) },
transform(Subst, HeadVars, Args, Body, VarSet1, Context, PredOrFunc,
Arity, IsAssertion, Goal0, VarSet, Warnings,
@@ -6809,12 +6894,8 @@
}
->
check_expr_purity(Purity, Context, Info0, Info1),
- { qual_info_get_mq_info(Info1 ^ qual_info, MQInfo0) },
- module_qual__qualify_lambda_mode_list(Modes1, Modes, Context,
- MQInfo0, MQInfo1),
- { qual_info_set_mq_info(Info1 ^ qual_info, MQInfo1,
- QualInfo1) },
- { Info2 = Info1 ^ qual_info := QualInfo1 },
+ make_hlds__qualify_lambda_mode_list(Modes1, Modes,
+ Context, Info1, Info2),
{ Det = Det1 },
{ term__coerce(GoalTerm1, GoalTerm) },
{ parse_goal(GoalTerm, VarSet0, ParsedGoal, VarSet1) },
@@ -6835,12 +6916,8 @@
Vars0, Modes0, Det)
}
->
- { qual_info_get_mq_info(Info0 ^ qual_info, MQInfo0) },
- module_qual__qualify_lambda_mode_list(Modes0, Modes, Context,
- MQInfo0, MQInfo1),
- { qual_info_set_mq_info(Info0 ^ qual_info, MQInfo1,
- QualInfo1) },
- { Info1 = Info0 ^ qual_info := QualInfo1 },
+ make_hlds__qualify_lambda_mode_list(Modes0, Modes,
+ Context, Info0, Info1),
{ term__coerce(GoalTerm0, GoalTerm) },
{ parse_dcg_pred_goal(GoalTerm, VarSet0,
ParsedGoal, DCG0, DCGn, VarSet1) },
@@ -7031,6 +7108,26 @@
{ list__append(ConjList0, ConjList1, ConjList) },
{ conj_list_to_goal(ConjList, GoalInfo, Goal) }.
+:- pred make_hlds__qualify_lambda_mode_list(list(mode), list(mode),
+ prog_context, transform_info, transform_info,
+ io__state, io__state).
+:- mode make_hlds__qualify_lambda_mode_list(in, out, in, in, out,
+ di, uo) is det.
+
+make_hlds__qualify_lambda_mode_list(Modes0, Modes, Context, Info0, Info) -->
+ % The modes in `.opt' files are already fully module qualified.
+ ( { Info0 ^ qual_info ^ import_status \= opt_imported } ->
+ { qual_info_get_mq_info(Info0 ^ qual_info, MQInfo0) },
+ module_qual__qualify_lambda_mode_list(Modes0, Modes,
+ Context, MQInfo0, MQInfo1),
+ { qual_info_set_mq_info(Info0 ^ qual_info,
+ MQInfo1, QualInfo1) },
+ { Info = Info0 ^ qual_info := QualInfo1 }
+ ;
+ { Modes = Modes0 },
+ { Info = Info0 }
+ ).
+
%-----------------------------------------------------------------------------%
:- pred check_expr_purity(purity, prog_context, transform_info,
@@ -7188,10 +7285,18 @@
process_type_qualification(Var, Type0, VarSet, Context, Info0, Info) -->
{ Info0 ^ qual_info = qual_info(EqvMap, TVarSet0, TVarRenaming0,
- TVarNameMap0, VarTypes0, MQInfo0, FoundError) },
+ TVarNameMap0, VarTypes0, MQInfo0, Status, FoundError) },
- module_qual__qualify_type_qualification(Type0, Type1,
- Context, MQInfo0, MQInfo),
+ ( { Status = opt_imported } ->
+ % Types in `.opt' files should already be
+ % fully module qualified.
+ { Type1 = Type0 },
+ { MQInfo = MQInfo0 }
+ ;
+ module_qual__qualify_type_qualification(Type0, Type1,
+ Context, MQInfo0, MQInfo)
+ ),
+
{
% Find any new type variables introduced by this type, and
% add them to the var-name index and the variable renaming.
@@ -7208,7 +7313,7 @@
},
update_var_types(VarTypes0, Var, Type, Context, VarTypes),
{ Info = Info0 ^ qual_info := qual_info(EqvMap, TVarSet, TVarRenaming,
- TVarNameMap, VarTypes, MQInfo, FoundError) }.
+ TVarNameMap, VarTypes, MQInfo, Status, FoundError) }.
:- pred update_var_types(map(prog_var, type), prog_var, type, prog_context,
map(prog_var, type), io__state, io__state).
@@ -7368,10 +7473,11 @@
% indexed by name.
vartypes :: map(prog_var, type), % Var types
mq_info :: mq_info, % Module qualification info.
+ import_status :: import_status,
found_syntax_error :: bool
% Was there a syntax error
% in an Aditi update.
- ).
+ ).
:- pred init_qual_info(mq_info, eqv_map, qual_info).
:- mode init_qual_info(in, in, out) is det.
@@ -7384,20 +7490,21 @@
map__init(VarTypes),
FoundSyntaxError = no,
QualInfo = qual_info(EqvMap, TVarSet, Renaming,
- Index, VarTypes, MQInfo, FoundSyntaxError).
+ Index, VarTypes, MQInfo, local, FoundSyntaxError).
% Update the qual_info when processing a new clause.
:- pred update_qual_info(qual_info, tvar_name_map, tvarset,
- map(prog_var, type), qual_info).
-:- mode update_qual_info(in, in, in, in, out) is det.
+ map(prog_var, type), import_status, qual_info).
+:- mode update_qual_info(in, in, in, in, in, out) is det.
-update_qual_info(QualInfo0, TVarNameMap, TVarSet, VarTypes, QualInfo) :-
+update_qual_info(QualInfo0, TVarNameMap, TVarSet,
+ VarTypes, Status, QualInfo) :-
QualInfo0 = qual_info(EqvMap, _TVarSet0, _Renaming0, _TVarNameMap0,
- _VarTypes0, MQInfo, _FoundError),
+ _VarTypes0, MQInfo, _Status, _FoundError),
% The renaming for one clause is useless in the others.
map__init(Renaming),
QualInfo = qual_info(EqvMap, TVarSet, Renaming, TVarNameMap,
- VarTypes, MQInfo, no).
+ VarTypes, MQInfo, Status, no).
:- pred qual_info_get_mq_info(qual_info, mq_info).
:- mode qual_info_get_mq_info(in, out) is det.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.184
diff -u -u -r1.184 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 2001/04/03 03:19:57 1.184
+++ compiler/mercury_to_mercury.m 2001/05/02 07:53:53
@@ -466,7 +466,7 @@
io__write_string(".\n").
mercury_output_item(nothing, _) --> [].
-mercury_output_item(typeclass(Constraints, ClassName, Vars, Methods,
+mercury_output_item(typeclass(Constraints, ClassName, Vars, Interface,
VarSet), _) -->
io__write_string(":- typeclass "),
@@ -488,11 +488,15 @@
mercury_output_class_constraint_list(Constraints, VarSet, "<=",
AppendVarnums),
- io__write_string(" where [\n"),
-
- output_class_methods(Methods),
-
- io__write_string("\n].\n").
+ (
+ { Interface = abstract },
+ io__write_string(".\n")
+ ;
+ { Interface = concrete(Methods) },
+ io__write_string(" where [\n"),
+ output_class_methods(Methods),
+ io__write_string("\n].\n")
+ ).
mercury_output_item(instance(Constraints, ClassName, Types, Body,
VarSet, _InstanceModuleName), _) -->
io__write_string(":- instance "),
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.5
diff -u -u -r1.5 ml_type_gen.m
--- compiler/ml_type_gen.m 2001/02/20 07:52:17 1.5
+++ compiler/ml_type_gen.m 2001/05/01 07:31:21
@@ -22,7 +22,7 @@
:- module ml_type_gen.
:- interface.
-:- import_module prog_data, hlds_module, hlds_data, mlds.
+:- import_module prog_data, hlds_module, mlds.
:- import_module io.
% Generate MLDS definitions for all the types in the HLDS.
@@ -57,6 +57,7 @@
:- implementation.
:- import_module hlds_pred, prog_data, prog_util, type_util, polymorphism.
+:- import_module hlds_data.
:- import_module ml_code_util.
:- import_module globals, options.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.65
diff -u -u -r1.65 module_qual.m
--- compiler/module_qual.m 2001/04/03 03:20:06 1.65
+++ compiler/module_qual.m 2001/05/01 07:17:37
@@ -182,7 +182,8 @@
% so we use a simpler data type here than hlds_pred__import_status.
:- type import_status
---> exported
- ; not_exported.
+ ; not_exported
+ ; imported.
% Pass over the item list collecting all defined module, type, mode and
% inst ids, all module synonym definitions, and the names of all
@@ -191,8 +192,14 @@
collect_mq_info([], Info, Info).
collect_mq_info([Item - _ | Items], Info0, Info) :-
- collect_mq_info_2(Item, Info0, Info1),
- collect_mq_info(Items, Info1, Info).
+ ( Item = module_defn(_, transitively_imported) ->
+ % Don't process the transitively imported items (from `.int2'
+ % files). They can't be used in the current module.
+ Info = Info0
+ ;
+ collect_mq_info_2(Item, Info0, Info1),
+ collect_mq_info(Items, Info1, Info)
+ ).
:- pred collect_mq_info_2(item::in, mq_info::in, mq_info::out) is det.
@@ -316,14 +323,16 @@
process_module_defn(implementation, Info0, Info) :-
mq_info_set_import_status(Info0, not_exported, Info).
process_module_defn(imported(_), Info0, Info) :-
- mq_info_set_import_status(Info0, not_exported, Info1),
+ mq_info_set_import_status(Info0, imported, Info1),
mq_info_set_need_qual_flag(Info1, may_be_unqualified, Info).
process_module_defn(used(_), Info0, Info) :-
- mq_info_set_import_status(Info0, not_exported, Info1),
+ mq_info_set_import_status(Info0, imported, Info1),
mq_info_set_need_qual_flag(Info1, must_be_qualified, Info).
process_module_defn(opt_imported, Info0, Info) :-
- mq_info_set_import_status(Info0, not_exported, Info1),
+ mq_info_set_import_status(Info0, imported, Info1),
mq_info_set_need_qual_flag(Info1, must_be_qualified, Info).
+process_module_defn(transitively_imported, _, _) :-
+ error("process_module_defn: transitively_imported item").
process_module_defn(external(_), Info, Info).
process_module_defn(end_module(_), Info, Info).
process_module_defn(export(_), Info, Info).
@@ -345,9 +354,10 @@
:- pred add_imports(sym_list::in, mq_info::in, mq_info::out) is det.
add_imports(Imports, Info0, Info) :-
- ( Imports = module(ImportedModules) ->
+ mq_info_get_import_status(Info0, Status),
+ ( Imports = module(ImportedModules), Status \= imported ->
mq_info_add_imported_modules(Info0, ImportedModules, Info1),
- ( mq_info_get_import_status(Info1, exported) ->
+ ( Status = exported ->
mq_info_add_unused_interface_modules(Info1,
ImportedModules, Info)
;
@@ -581,7 +591,15 @@
{ Id = Name - Arity },
{ mq_info_set_error_context(Info0, class(Id) - Context, Info1) },
qualify_class_constraint_list(Constraints0, Constraints, Info1, Info2),
- qualify_class_interface(Interface0, Interface, Info2, Info).
+ (
+ { Interface0 = abstract },
+ { Interface = abstract },
+ { Info = Info2 }
+ ;
+ { Interface0 = concrete(Methods0) },
+ qualify_class_interface(Methods0, Methods, Info2, Info),
+ { Interface = concrete(Methods) }
+ ).
module_qualify_item(instance(Constraints0, Name0, Types0, Body0, VarSet,
ModName) - Context,
@@ -602,6 +620,7 @@
bool::out) is det.
update_import_status(opt_imported, Info, Info, no).
+update_import_status(transitively_imported, Info, Info, no).
update_import_status(module(_), Info, Info, yes).
update_import_status(interface, Info0, Info, yes) :-
mq_info_set_import_status(Info0, exported, Info).
@@ -1031,8 +1050,9 @@
find_unique_match(Class0, Class, ClassIdSet, class_id,
MQInfo0, MQInfo).
-:- pred qualify_class_interface(class_interface::in, class_interface::out,
- mq_info::in, mq_info::out, io__state::di, io__state::uo) is det.
+:- pred qualify_class_interface(list(class_method)::in,
+ list(class_method)::out, mq_info::in, mq_info::out,
+ io__state::di, io__state::uo) is det.
qualify_class_interface([], [], MQInfo, MQInfo) --> [].
qualify_class_interface([M0|M0s], [M|Ms], MQInfo0, MQInfo) -->
@@ -1394,8 +1414,6 @@
% is_builtin_atomic_type(TypeId)
% is true iff 'TypeId' is the type_id of a builtin atomic type
-
-:- type type_id == id.
:- pred is_builtin_atomic_type(type_id).
:- mode is_builtin_atomic_type(in) is semidet.
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.158
diff -u -u -r1.158 modules.m
--- compiler/modules.m 2001/04/08 08:59:21 1.158
+++ compiler/modules.m 2001/05/01 07:23:11
@@ -1282,12 +1282,13 @@
% Process the short interfaces for indirectly imported modules.
% The short interfaces are treated as if
% they are imported using `use_module'.
- { append_pseudo_decl(Module10, used(interface), Module11) },
+ { append_pseudo_decl(Module10, transitively_imported, Module11) },
+ { append_pseudo_decl(Module11, used(interface), Module12) },
process_module_short_interfaces_transitively(IntIndirectImports,
- ".int2", Module11, Module12),
- { append_pseudo_decl(Module12, used(implementation), Module13) },
+ ".int2", Module12, Module13),
+ { append_pseudo_decl(Module13, used(implementation), Module14) },
process_module_short_interfaces_transitively(ImpIndirectImports,
- ".int2", Module13, Module),
+ ".int2", Module14, Module),
{ module_imports_get_error(Module, Error) }.
@@ -4444,7 +4445,7 @@
Items1 = Items0,
Imports1 = [ItemAndContext | Imports0],
NeedsImports1 = NeedsImports0
- ; make_abstract_type_defn(Item0, Kind, Item1) ->
+ ; make_abstract_defn(Item0, Kind, Item1) ->
Imports1 = Imports0,
Items1 = [Item1 - Context | Items0],
NeedsImports1 = NeedsImports0
@@ -4467,16 +4468,15 @@
include_in_short_interface(inst_defn(_, _, _)).
include_in_short_interface(mode_defn(_, _, _)).
include_in_short_interface(module_defn(_, _)).
-include_in_short_interface(typeclass(_, _, _, _, _)).
-:- pred make_abstract_type_defn(item, short_interface_kind, item).
-:- mode make_abstract_type_defn(in, in, out) is semidet.
+:- pred make_abstract_defn(item, short_interface_kind, item).
+:- mode make_abstract_defn(in, in, out) is semidet.
-make_abstract_type_defn(type_defn(VarSet, du_type(Name, Args, _, _), Cond), _,
+make_abstract_defn(type_defn(VarSet, du_type(Name, Args, _, _), Cond), _,
type_defn(VarSet, abstract_type(Name, Args), Cond)).
-make_abstract_type_defn(type_defn(VarSet, abstract_type(Name, Args), Cond), _,
+make_abstract_defn(type_defn(VarSet, abstract_type(Name, Args), Cond), _,
type_defn(VarSet, abstract_type(Name, Args), Cond)).
-make_abstract_type_defn(type_defn(VarSet, eqv_type(Name, Args, _), Cond),
+make_abstract_defn(type_defn(VarSet, eqv_type(Name, Args, _), Cond),
ShortInterfaceKind,
type_defn(VarSet, abstract_type(Name, Args), Cond)) :-
% For the `.int2' files, we need the full definitions of
@@ -4488,6 +4488,9 @@
% So we convert equivalence types into abstract types only for
% the `.int3' files.
ShortInterfaceKind = int3.
+make_abstract_defn(typeclass(A, B, C, _, E), _,
+ typeclass(A, B, C, abstract, E)).
+
% All instance declarations must be written
% to `.int' files as abstract instance
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.65
diff -u -u -r1.65 prog_data.m
--- compiler/prog_data.m 2001/04/03 03:20:15 1.65
+++ compiler/prog_data.m 2001/05/01 07:18:23
@@ -455,7 +455,9 @@
:- type class_name == sym_name.
-:- type class_interface == list(class_method).
+:- type class_interface
+ ---> abstract
+ ; concrete(list(class_method)).
:- type class_method
---> pred(tvarset, inst_varset, existq_tvars, sym_name,
@@ -720,6 +722,8 @@
% used for sets of type variables
:- type tsubst == map(tvar, type). % used for type substitutions
+:- type type_id == pair(sym_name, arity).
+
% existq_tvars is used to record the set of type variables which are
% existentially quantified
:- type existq_tvars == list(tvar).
@@ -866,6 +870,13 @@
% This is used internally by the compiler,
% to identify items which originally
% came from a .opt file.
+ ; transitively_imported
+ % This is used internally by the compiler,
+ % to identify items which originally
+ % came from a .opt file.
+ % came from a `.opt' or `.int2' file.
+ % These should not be allowed to
+ % match items in the current module.
; external(sym_name_specifier)
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.18
diff -u -u -r1.18 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 2000/11/01 05:12:13 1.18
+++ compiler/prog_io_typeclass.m 2001/05/01 07:54:58
@@ -67,7 +67,7 @@
NameString, Vars, _, _))
->
Result = ok(typeclass(Constraints, NameString, Vars,
- MethodList, TVarSet))
+ concrete(MethodList), TVarSet))
;
% if the item we get back isn't a typeclass,
% something has gone wrong...
@@ -158,11 +158,16 @@
MaybeClassName = ok(ClassName, TermVars0),
list__map(term__coerce, TermVars0, TermVars),
(
- term__var_list_to_term_list(Vars, TermVars)
+ term__var_list_to_term_list(Vars, TermVars),
+ list__sort_and_remove_dups(TermVars, SortedTermVars),
+ list__length(SortedTermVars) =
+ list__length(TermVars) `with_type` int
->
- Result = ok(typeclass([], ClassName, Vars, [], TVarSet))
+ Result = ok(typeclass([], ClassName, Vars,
+ abstract, TVarSet))
;
- Result = error("expected variables as class parameters",
+ Result = error(
+ "expected distinct variables as class parameters",
Name)
)
;
@@ -170,7 +175,8 @@
Result = error(String, Term)
).
-:- pred parse_class_methods(module_name, term, varset, maybe1(class_interface)).
+:- pred parse_class_methods(module_name, term, varset,
+ maybe1(list(class_method))).
:- mode parse_class_methods(in, in, in, out) is det.
parse_class_methods(ModuleName, Methods, VarSet, Result) :-
Index: compiler/vn_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_type.m,v
retrieving revision 1.46
diff -u -u -r1.46 vn_type.m
--- compiler/vn_type.m 2000/10/13 04:05:30 1.46
+++ compiler/vn_type.m 2001/05/01 06:50:51
@@ -14,7 +14,7 @@
:- interface.
:- import_module hlds_goal, llds, builtin_ops, livemap, options.
-:- import_module getopt, map, set, list, std_util, counter.
+:- import_module getopt, map, set, list, std_util, counter, term.
:- type vn == int.
Index: compiler/notes/todo.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/todo.html,v
retrieving revision 1.10
diff -u -u -r1.10 todo.html
--- compiler/notes/todo.html 1999/12/11 16:36:47 1.10
+++ compiler/notes/todo.html 2001/05/01 07:01:39
@@ -80,10 +80,6 @@
independently of any declarations or imports in the implementation
section
-<li> use_module should not be transitive
- (currently we get this right for predicates, constants, and functors,
- but wrong for types, insts, and modes).
-
<li> there are some problems with nested modules (see the language
reference manual)
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.82
diff -u -u -r1.82 Mmakefile
--- tests/invalid/Mmakefile 2001/04/29 07:54:37 1.82
+++ tests/invalid/Mmakefile 2001/05/02 03:34:13
@@ -19,6 +19,7 @@
imported_mode.m \
partial_implied_mode.m \
test_nested.m \
+ transitive_import_class.m \
undef_mod_qual.m
SINGLEMODULE_SOURCES= \
@@ -45,8 +46,9 @@
ho_unique_error.m \
impure_method_impl.m \
inline_conflict.m \
- invalid_main.m \
inst_list_dup.m \
+ invalid_main.m \
+ invalid_typeclass.m \
io_in_ite_cond.m \
lambda_syntax_error.m \
method_impl.m \
@@ -76,6 +78,7 @@
spurious_mode_error.m \
tc_err1.m \
tc_err2.m \
+ transitive_import.m \
tricky_assert1.m \
type_inf_loop.m \
type_loop.m \
Index: tests/invalid/invalid_typeclass.err_exp
===================================================================
RCS file: invalid_typeclass.err_exp
diff -N invalid_typeclass.err_exp
--- /dev/null Mon Apr 16 11:57:05 2001
+++ invalid_typeclass.err_exp Wed May 2 15:46:02 2001
@@ -0,0 +1,9 @@
+invalid_typeclass.m:011: Error: expected distinct variables as class parameters: class3(_1, _1).
+invalid_typeclass.m:017: Error: typeclass `invalid_typeclass:class2/1' multiply defined.
+invalid_typeclass.m:009: Here is the previous definition of typeclass `invalid_typeclass:class2/1'.
+invalid_typeclass.m:017: The superclass constraints do not match.
+invalid_typeclass.m:007: Error: no definition for typeclass
+invalid_typeclass.m:007: `invalid_typeclass:class/1'.
+invalid_typeclass.m:009: Error: no definition for typeclass
+invalid_typeclass.m:009: `invalid_typeclass:class2/1'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/invalid_typeclass.m
===================================================================
RCS file: invalid_typeclass.m
diff -N invalid_typeclass.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ invalid_typeclass.m Wed May 2 15:45:19 2001
@@ -0,0 +1,19 @@
+:- module invalid_typeclass.
+
+:- interface.
+
+:- import_module enum.
+
+:- typeclass class(T).
+
+:- typeclass class2(T) <= enum(T).
+
+:- typeclass class3(T, T) where [
+ func f(T) = T
+].
+
+:- implementation.
+
+:- typeclass class2(T) where [
+ func add1(T) = T
+].
Index: tests/invalid/transitive_import.err_exp
===================================================================
RCS file: transitive_import.err_exp
diff -N transitive_import.err_exp
--- /dev/null Mon Apr 16 11:57:05 2001
+++ transitive_import.err_exp Wed May 2 13:33:08 2001
@@ -0,0 +1,7 @@
+transitive_import.m:016: In declaration of instance of typeclass `enum:enum'/1:
+transitive_import.m:016: error: undefined typeclass `enum:enum'/1
+transitive_import.m:016: (the module `enum' has not been imported).
+transitive_import.m:025: In definition of function `transitive_import:assoc_list_first'/1:
+transitive_import.m:025: error: undefined type `std_util:pair'/2
+transitive_import.m:025: (the module `std_util' has not been imported).
+For more information, try recompiling with `-E'.
Index: tests/invalid/transitive_import.m
===================================================================
RCS file: transitive_import.m
diff -N transitive_import.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ transitive_import.m Wed May 2 17:13:06 2001
@@ -0,0 +1,32 @@
+% This is a regression test. Up until May 2001, types, insts, modes
+% and typeclasses from transitively imported modules (for which the
+% `.int2' file is read) could be used if each reference was fully
+% module qualified.
+:- module transitive_import.
+
+:- interface.
+
+:- import_module assoc_list, int.
+
+:- type enum
+ ---> a
+ ; b
+ ; c.
+
+:- instance enum__enum(enum) where [
+ to_int(a) = 1,
+ to_int(b) = 2,
+ to_int(c) = 3,
+ from_int(1) = a,
+ from_int(2) = b,
+ from_int(3) = c
+].
+
+:- func assoc_list_first(assoc_list(int, V)) =
+ std_util__pair(int, V) is semidet.
+
+:- implementation.
+
+:- import_module list.
+
+assoc_list_first([H | _]) = H.
Index: tests/invalid/transitive_import_class.err_exp
===================================================================
RCS file: transitive_import_class.err_exp
diff -N transitive_import_class.err_exp
--- /dev/null Mon Apr 16 11:57:05 2001
+++ transitive_import_class.err_exp Wed May 2 17:13:31 2001
@@ -0,0 +1,10 @@
+transitive_import_class.m:017: In clause for function `transitive_import_class:semidet_id/1':
+transitive_import_class.m:017: in function result term of clause head:
+transitive_import_class.m:017: error: undefined symbol `transitive_import_class3:to_int/1'
+transitive_import_class.m:017: (the module `transitive_import_class3' has not been imported).
+transitive_import_class.m:017: In clause for function `transitive_import_class:semidet_id/1':
+transitive_import_class.m:017: in function result term of clause head:
+transitive_import_class.m:017: in argument 1 of functor `transitive_import_class3:to_int/1':
+transitive_import_class.m:017: error: undefined symbol `transitive_import_class3:from_int/1'
+transitive_import_class.m:017: (the module `transitive_import_class3' has not been imported).
+For more information, try recompiling with `-E'.
Index: tests/invalid/transitive_import_class.m
===================================================================
RCS file: transitive_import_class.m
diff -N transitive_import_class.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ transitive_import_class.m Wed May 2 17:12:27 2001
@@ -0,0 +1,18 @@
+% This is a regression test. Up until May 2001, typeclass methods
+% from transitively imported modules (for which the `.int2'
+% file is read) could be used if each reference was fully
+% module qualified.
+:- module transitive_import_class.
+
+:- interface.
+
+:- import_module int.
+
+:- func semidet_id(int) = int is semidet.
+
+:- implementation.
+
+:- import_module transitive_import_class2.
+
+semidet_id(X) = transitive_import_class3__to_int(
+ transitive_import_class3__from_int(X) `with_type` int).
Index: tests/invalid/transitive_import_class2.m
===================================================================
RCS file: transitive_import_class2.m
diff -N transitive_import_class2.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ transitive_import_class2.m Wed May 2 13:29:00 2001
@@ -0,0 +1,19 @@
+% This is a regression test. Up until May 2001, types, insts, modes
+% and typeclasses from transitively imported modules (for which the `.int2'
+% file is read) could be referred to if the reference was fully
+% module qualified.
+:- module transitive_import_class2.
+
+:- interface.
+
+:- import_module transitive_import_class3.
+
+:- instance my_enum(int).
+
+:- implementation.
+
+:- instance my_enum(int) where [
+ to_int(X) = X,
+ from_int(X) = X
+].
+
Index: tests/invalid/transitive_import_class3.m
===================================================================
RCS file: transitive_import_class3.m
diff -N transitive_import_class3.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ transitive_import_class3.m Wed May 2 13:29:16 2001
@@ -0,0 +1,13 @@
+:- module transitive_import_class3.
+
+:- interface.
+
+ % For all instances the following must hold:
+ % all [X, Int] (X = from_int(to_int(X)))
+:- typeclass my_enum(T) where [
+ func to_int(T) = int,
+ func from_int(int) = T is semidet
+].
+
+:- implementation.
+
--------------------------------------------------------------------------
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