[m-rev.] diff: check_typeclass.m cleanup
Zoltan Somogyi
zs at csse.unimelb.edu.au
Sun Dec 30 22:08:55 AEDT 2007
compiler/check_typeclass.m:
Improve formatting.
Zoltan.
cvs diff: Diffing .
Index: check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.118
diff -u -b -r1.118 check_typeclass.m
--- check_typeclass.m 30 Dec 2007 08:23:32 -0000 1.118
+++ check_typeclass.m 30 Dec 2007 08:38:44 -0000
@@ -1266,17 +1266,18 @@
class_id::in, list(hlds_instance_defn)::in,
list(error_spec)::in, list(error_spec)::out) is det.
-check_instance_declaration_types(MI, ClassId, InstanceDefns, !Specs) :-
- list.foldl(check_one_instance_declaration_types(MI, ClassId),
+check_instance_declaration_types(ModuleInfo, ClassId, InstanceDefns, !Specs) :-
+ list.foldl(check_one_instance_declaration_types(ModuleInfo, ClassId),
InstanceDefns, !Specs).
:- pred check_one_instance_declaration_types(module_info::in,
class_id::in, hlds_instance_defn::in,
list(error_spec)::in, list(error_spec)::out) is det.
-check_one_instance_declaration_types(MI, ClassId, InstanceDefn, !Specs) :-
+check_one_instance_declaration_types(ModuleInfo, ClassId, InstanceDefn,
+ !Specs) :-
Types = InstanceDefn ^ instance_types,
- list.foldl3(is_valid_instance_type(MI, ClassId, InstanceDefn),
+ list.foldl3(is_valid_instance_type(ModuleInfo, ClassId, InstanceDefn),
Types, 1, _, set.init, _, !Specs).
% Each of these types in the instance declaration must be either a
@@ -1288,15 +1289,25 @@
int::in, int::out, set(mer_type)::in, set(mer_type)::out,
list(error_spec)::in, list(error_spec)::out) is det.
-is_valid_instance_type(_MI, _ClassId, _InstanceDefn,
- builtin_type(_), N, N+1, !SeenTypes, !Specs).
-is_valid_instance_type(_MI, ClassId, InstanceDefn,
- higher_order_type(_, _, _, _), N, N+1, !SeenTypes, !Specs) :-
- Err = [words("is a higher order type")],
- Spec = error_message_2(ClassId, InstanceDefn, N, Err),
- !:Specs = [Spec | !.Specs].
-is_valid_instance_type(_MI, ClassId, InstanceDefn,
- tuple_type(Args, _), N, N+1, !SeenTypes, !Specs) :-
+is_valid_instance_type(ModuleInfo, ClassId, InstanceDefn, Type,
+ N, N+1, !SeenTypes, !Specs) :-
+ (
+ Type = builtin_type(_)
+ ;
+ (
+ Type = higher_order_type(_, _, _, _),
+ Pieces = [words("is a higher order type")]
+ ;
+ Type = apply_n_type(_, _, _),
+ Pieces = [words("is an apply/N type")]
+ ;
+ Type = type_variable(_, _),
+ Pieces = [words("is a type variable")]
+ ),
+ Spec = error_message_2(ClassId, InstanceDefn, N, Pieces),
+ !:Specs = [Spec | !.Specs]
+ ;
+ Type = tuple_type(Args, _),
each_arg_is_a_distinct_type_variable(!.SeenTypes, Args, 1, Result),
(
Result = no_error,
@@ -1308,35 +1319,25 @@
),
Spec = error_message(ClassId, InstanceDefn, N, Result),
!:Specs = [Spec | !.Specs]
- ).
-is_valid_instance_type(_MI, ClassId, InstanceDefn,
- apply_n_type(_, _, _), N, N+1, !SeenTypes, !Specs) :-
- Err = [words("is an apply/N type")],
- Spec = error_message_2(ClassId, InstanceDefn, N, Err),
- !:Specs = [Spec | !.Specs].
-is_valid_instance_type(_MI, _ClassId, _InstanceDefn,
- kinded_type(_, _), N, N+1, !SeenTypes, !Specs) :-
- unexpected("check_typeclass", "kinded_type").
-is_valid_instance_type(_MI, ClassId, InstanceDefn,
- type_variable(_, _), N, N+1, !SeenTypes, !Specs) :-
- Err = [words("is a type variable")],
- Spec = error_message_2(ClassId, InstanceDefn, N, Err),
- !:Specs = [Spec | !.Specs].
-is_valid_instance_type(MI, ClassId, InstanceDefn,
- Type @ defined_type(TypeName, Args, _), N, N+1, !SeenTypes, !Specs) :-
+ )
+ ;
+ Type = kinded_type(_, _),
+ unexpected("check_typeclass", "kinded_type")
+ ;
+ Type = defined_type(TypeName, Args, _),
each_arg_is_a_distinct_type_variable(!.SeenTypes, Args, 1, Result),
(
Result = no_error,
svset.insert_list(Args, !SeenTypes),
- ( type_to_type_defn(MI, Type, TypeDefn) ->
+ ( type_to_type_defn(ModuleInfo, Type, TypeDefn) ->
list.length(Args, TypeArity),
- is_visible_instance_type(TypeName, TypeArity, TypeDefn, ClassId,
- InstanceDefn, !Specs),
+ is_visible_instance_type(TypeName, TypeArity, TypeDefn,
+ ClassId, InstanceDefn, !Specs),
get_type_defn_body(TypeDefn, TypeBody),
(
TypeBody = hlds_eqv_type(EqvType),
- is_valid_instance_type(MI, ClassId, InstanceDefn, EqvType, N,
- _, !SeenTypes, !Specs)
+ is_valid_instance_type(ModuleInfo, ClassId, InstanceDefn,
+ EqvType, N, _, !SeenTypes, !Specs)
;
( TypeBody = hlds_du_type(_, _, _, _, _, _, _, _)
; TypeBody = hlds_foreign_type(_)
@@ -1355,6 +1356,7 @@
),
Spec = error_message(ClassId, InstanceDefn, N, Result),
!:Specs = [Spec | !.Specs]
+ )
).
% Check that types that are referred to in an abstract instance
@@ -1450,21 +1452,20 @@
error_message(ClassId, InstanceDefn, N, Error) = Spec :-
(
Error = local_non_distinct,
- Err =
- [words("is not a type whose arguments are distinct type variables")]
+ Err = [words("is not a type"),
+ words("whose arguments are distinct type variables")]
;
Error = global_non_distinct,
Err = [words("contains a type variable which is used in another arg")]
;
Error = arg_not_type_variable(ArgNum),
- Err = [
- words("is a type whose"), nth_fixed(ArgNum),
+ Err = [words("is a type whose"), nth_fixed(ArgNum),
words("arg is not a variable")]
),
Spec = error_message_2(ClassId, InstanceDefn, N, Err).
-:- func error_message_2(
- class_id, hlds_instance_defn, int, format_components) = error_spec.
+:- func error_message_2(class_id, hlds_instance_defn, int, format_components)
+ = error_spec.
error_message_2(ClassId, InstanceDefn, N, Pieces) = Spec :-
ClassId = class_id(ClassName, _),
cvs diff: Diffing notes
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list