[m-rev.] diff: split typecheck into smaller modules

[Mark Brown]

The full diff for this change is long and boring; there are no code changes
apart from moving things around.  Attached below is that part of the diff
not including typecheck.m and the new modules.  The full diff can be found
in ~mark/diff.typecheck if anyone wants to see it.

Cheers,
Mark.

Estimated hours taken: 3
Branches: main

Split typecheck.m into smaller modules.

compiler/typecheck.m:
	The main typechecking pass.

compiler/typecheck_errors.m:
	New module.  Error messages and debugging messages.

compiler/typecheck_info.m:
	New module.  The typecheck_info and type_assign data structures, plus
	some basic predicates.

compiler/typeclasses.m:
	New module.  The context reduction and improvement rules.

compiler/check_hlds.m:
	Register the new modules.

compiler/check_typeclass.m:
	Call typeclasses instead of typecheck to do context reduction.

compiler/prog_type.m:
	Move strip_builtin_qualifiers_from_type(_list) to here.

compiler/hlds_data.m:
	Define restrict_list_elements here instead of in typecheck.m and
	check_typeclass.m.

Index: compiler/check_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_hlds.m,v
retrieving revision 1.8
diff -u -r1.8 check_hlds.m
--- compiler/check_hlds.m	22 Feb 2005 12:32:10 -0000	1.8
+++ compiler/check_hlds.m	21 Apr 2005 02:24:22 -0000
@@ -27,6 +27,9 @@
     :- include_module purity.
     :- include_module type_util.
     :- include_module typecheck.
+    :- include_module typecheck_errors.
+    :- include_module typecheck_info.
+    :- include_module typeclasses.
 %:- end_module type_analysis.
 
 % Polymorphism transformation.
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.71
diff -u -r1.71 check_typeclass.m
--- compiler/check_typeclass.m	21 Apr 2005 23:52:33 -0000	1.71
+++ compiler/check_typeclass.m	23 Apr 2005 05:48:54 -0000
@@ -81,7 +81,7 @@
 
 :- import_module check_hlds__inst_match.
 :- import_module check_hlds__mode_util.
-:- import_module check_hlds__typecheck.
+:- import_module check_hlds__typeclasses.
 :- import_module check_hlds__type_util.
 :- import_module hlds__hlds_code_util.
 :- import_module hlds__hlds_data.
@@ -915,7 +915,7 @@
 		% instance constraints and the usual context reduction rules.
 		%
 	map__init(ConstraintMap0),
-	typecheck__reduce_context_by_rule_application(ClassTable,
+	typeclasses__reduce_context_by_rule_application(ClassTable,
 		InstanceTable, SuperClassTable, ClassVars, TypeSubst, _,
 		InstanceVarSet1, InstanceVarSet2,
 		Proofs0, Proofs1, ConstraintMap0, _,
@@ -1477,25 +1477,6 @@
 	write_error_pieces(ContextA, 0, ErrorPiecesA, !IO),
 	write_error_pieces(ContextB, 0, ErrorPiecesB, !IO),
 	io__set_exit_status(1, !IO).
-
-	% XXX this is duplicated in typecheck
-:- func restrict_list_elements(set(hlds_class_argpos), list(T)) = list(T).
-
-restrict_list_elements(Elements, List) =
-        restrict_list_elements_2(Elements, 1, List).
-
-:- func restrict_list_elements_2(set(hlds_class_argpos), int, list(T)) =
-	list(T).
-
-restrict_list_elements_2(_, _, []) = [].
-restrict_list_elements_2(Elements, Index, [X | Xs]) =
-        (
-                set__member(Index, Elements)
-        ->
-                [X | restrict_list_elements_2(Elements, Index + 1, Xs)]
-        ;
-                restrict_list_elements_2(Elements, Index + 1, Xs)
-        ).
 
 %---------------------------------------------------------------------------%
 
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.93
diff -u -r1.93 hlds_data.m
--- compiler/hlds_data.m	20 Apr 2005 12:57:10 -0000	1.93
+++ compiler/hlds_data.m	23 Apr 2005 05:47:59 -0000
@@ -839,6 +839,8 @@
 
 :- type hlds_class_argpos == int.
 
+:- func restrict_list_elements(set(hlds_class_argpos), list(T)) = list(T).
+
 :- type hlds_class_interface	==	list(hlds_class_proc).
 :- type hlds_class_proc
 	---> 	hlds_class_proc(
@@ -886,6 +888,30 @@
 					% the constraints on the class
 					% declaration), for this instance.
 	).
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+restrict_list_elements(Elements, List) =
+	restrict_list_elements_2(Elements, 1, List).
+
+:- func restrict_list_elements_2(set(hlds_class_argpos), hlds_class_argpos,
+	list(T)) = list(T).
+
+restrict_list_elements_2(_, _, []) = [].
+restrict_list_elements_2(Elements, Index, [X | Xs]) =
+	(
+		set__member(Index, Elements)
+	->
+		[X | restrict_list_elements_2(Elements, Index + 1, Xs)]
+	;
+		restrict_list_elements_2(Elements, Index + 1, Xs)
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- interface.
 
 	% Identifiers for constraints which are unique across a given
 	% type_assign.  Integers in these values refer to the position in
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.4
diff -u -r1.4 prog_type.m
--- compiler/prog_type.m	20 Apr 2005 12:57:15 -0000	1.4
+++ compiler/prog_type.m	21 Apr 2005 05:47:32 -0000
@@ -84,6 +84,14 @@
 :- pred construct_higher_order_func_type(purity::in, lambda_eval_method::in,
 	list(type)::in, (type)::in, (type)::out) is det.
 	
+	% Make error messages more readable by removing "builtin."
+	% qualifiers.
+	%
+:- pred strip_builtin_qualifiers_from_type((type)::in, (type)::out) is det.
+
+:- pred strip_builtin_qualifiers_from_type_list(list(type)::in,
+	list(type)::out) is det.
+
 %-----------------------------------------------------------------------------%
 %
 % Utility predicates dealing with typeclass constraints.
@@ -378,6 +386,26 @@
 qualify_higher_order_type((aditi_bottom_up), Type0,
 	term.functor(term.atom("aditi_bottom_up"), [Type0], Context)) :-
 	term.context_init(Context).
+
+strip_builtin_qualifiers_from_type(Type0, Type) :-
+	( type_to_ctor_and_args(Type0, TypeCtor0, Args0) ->
+		strip_builtin_qualifiers_from_type_list(Args0, Args),
+		TypeCtor0 = SymName0 - Arity,
+		(
+			SymName0 = qualified(Module, Name),
+			mercury_public_builtin_module(Module)
+		->
+			SymName = unqualified(Name)
+		;
+			SymName = SymName0
+		),
+		construct_type(SymName - Arity, Args, Type)
+	;
+		Type = Type0
+	).
+
+strip_builtin_qualifiers_from_type_list(Types0, Types) :-
+	list__map(strip_builtin_qualifiers_from_type, Types0, Types).
 
 %-----------------------------------------------------------------------------%
 
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------