for review: conditionally include Aditi support

[Simon Taylor]

Estimated hours taken: 3

Preprocess mercury_compile.m and rl_file.m to remove dependencies
on rl_code.m. This is done to avoid major mode analysis efficiency
problems on the alias branch.

Mmake.common.in:
	Include the Aditi support by default.

compiler/Mmakefile:
	Add rules to process `.pp' files.

compiler/mercury_compile.pp:
compiler/rl_file.pp:
	Add preprocessing to remove dependencies on 

compiler/mercury_compile.m:
compiler/rl_file.m:
	Removed.

compiler/rl_out.m:
compiler/rl.m:
	Move the code to convert schemas to strings into rl.m
	so that rl_out.m does not need to be imported anywhere
	if Aditi-RL output is not needed. 

compiler/rl_gen.m:
compiler/magic.m:
	Avoid importing rl_out.m.

Index: Mmake.common.in
===================================================================
RCS file: /home/staff/zs/imp/mercury/Mmake.common.in,v
retrieving revision 1.36
diff -u -u -r1.36 Mmake.common.in
--- Mmake.common.in	1999/03/21 16:00:30	1.36
+++ Mmake.common.in	1999/04/14 07:11:39
@@ -178,6 +178,16 @@
 # complicating things.
 LIBRARY_INTERMODULE = yes
 
+# Do we want to include the support for Aditi compilation in the compiler?
+# It is not practical to include the code to output Aditi-RL in the alias
+# branch compiler - it currently takes more than an hour to compile
+# compiler/rl_code.m, due to performance problems compiling large disjunctions
+# with the new mode checker.
+# To disable the Aditi support, put `INCLUDE_ADITI_OUTPUT = no'
+# in Mmake.stage.params. Do not put this into Mmake.params - we still
+# want to check that the Aditi code compiles after any changes.
+INCLUDE_ADITI_OUTPUT = yes
+
 #-----------------------------------------------------------------------------#
 
 # The Mmake.params file can be used to override definitions in this file
Index: compiler/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/Mmakefile,v
retrieving revision 1.15
diff -u -u -r1.15 Mmakefile
--- Mmakefile	1999/03/15 00:39:25	1.15
+++ Mmakefile	1999/03/31 07:14:15
@@ -60,6 +60,33 @@
 
 #-----------------------------------------------------------------------------#
 
+# Rules for preprocessing `.pp' files.
+
+ifeq ($(INCLUDE_ADITI_OUTPUT),yes)
+
+# Remove the #if line and everything between the #else and #endif lines.
+%.m: %.pp
+	@-[ ! -f $@ ] || chmod +w $@
+	sed	-e '/^#if *INCLUDE_ADITI_OUTPUT/s/.*//' \
+		-e '/^#else/,/^#endif/s/.*//' \
+		$< > $@
+	@-chmod -w $@
+
+else
+
+# Remove everything between the #if line and the #else line,
+# and the #endif line.
+%.m: %.pp
+	@-[ ! -f $@ ] || chmod +w $@
+	sed	-e '/^#if *INCLUDE_ADITI_OUTPUT/,/^#else/s/.*//' \
+		-e '/^#endif/s/.*//' \
+		$< > $@
+	@-chmod -w $@
+
+endif
+
+#-----------------------------------------------------------------------------#
+
 # targets
 #
 # mercury_compile
@@ -71,6 +98,10 @@
 .PHONY: depend
 depend:		mercury_compile.depend
 
+# we need to make sure the .pp files get converted to .m before
+# we do the make depend
+mercury_compile.depend: mercury_compile.m rl_file.m
+
 .PHONY: all
 all:		mercury nuprolog sicstus
 
@@ -136,6 +167,11 @@
 #-----------------------------------------------------------------------------#
 
 clean:
+	for file in *.pp; do \
+		if [ "$$file" != "*.pp" ]; then \
+			rm -f `basename $$file .pp`.m; \
+		fi \
+	done
 
 realclean:
 	rm -f tags mercury_compile.stats
Index: compiler/magic.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/magic.m,v
retrieving revision 1.2
diff -u -u -r1.2 magic.m
--- magic.m	1999/03/22 08:07:23	1.2
+++ magic.m	1999/03/31 04:59:06
@@ -166,7 +166,7 @@
 
 :- import_module magic_util, context.
 :- import_module dependency_graph, hlds_pred, hlds_goal, hlds_data, prog_data.
-:- import_module passes_aux, mode_util, (inst), instmap, rl_gen, rl, rl_out.
+:- import_module passes_aux, mode_util, (inst), instmap, rl_gen, rl.
 :- import_module globals, options, hlds_out, prog_out, goal_util, type_util.
 :- import_module polymorphism, quantification.
 
@@ -1206,7 +1206,7 @@
 	{ magic_util__remove_aditi_state(ArgTypes0, ArgTypes0, ArgTypes) },
 	{ magic_util__remove_aditi_state(ArgTypes0, ArgModes0, ArgModes) },
 	{ partition_args(ModuleInfo, ArgModes, ArgTypes, InputArgTypes, _) },
-	{ rl_out__schema_to_string(ModuleInfo, InputArgTypes, InputSchema) }.
+	{ rl__schema_to_string(ModuleInfo, InputArgTypes, InputSchema) }.
 
 :- pred magic__make_type_info_vars(list(type)::in, list(prog_var)::out,
 	list(hlds_goal)::out, pred_info::in, pred_info::out,
Index: compiler/rl.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/rl.m,v
retrieving revision 1.1
diff -u -u -r1.1 rl.m
--- rl.m	1998/12/06 23:44:39	1.1
+++ rl.m	1999/04/01 05:05:08
@@ -471,9 +471,36 @@
 :- pred rl__relation_id_to_string(relation_id::in, string::out) is det.
 
 %-----------------------------------------------------------------------------%
+
+	% rl__schemas_to_strings(ModuleInfo, SchemaLists,
+	%	TypeDecls, SchemaStrings)
+	% 
+	% Convert a list of lists of types to a list of schema strings,
+	% with the declarations for the types used in TypeDecls.
+:- pred rl__schemas_to_strings(module_info::in,
+		list(list(type))::in, string::out, list(string)::out) is det.
+			
+	% Convert a list of types to a schema string.
+:- pred rl__schema_to_string(module_info::in,
+		list(type)::in, string::out) is det.
+
+	% Produce names acceptable to Aditi (just wrap single
+	% quotes around non-alphanumeric-and-underscore names).
+:- pred rl__mangle_and_quote_type_name(type_id::in, list(type)::in,
+		string::out) is det.
+:- pred rl__mangle_and_quote_ctor_name(sym_name::in,
+		int::in, string::out) is det.
+
+	% The expression stuff expects that constructor
+	% and type names are unquoted.
+:- pred rl__mangle_type_name(type_id::in, list(type)::in,
+		string::out) is det.
+:- pred rl__mangle_ctor_name(sym_name::in, int::in, string::out) is det.
+
+%-----------------------------------------------------------------------------%
 :- implementation.
 
-:- import_module globals, options.
+:- import_module globals, options, prog_out, prog_util, type_util.
 :- import_module bool, int, require, string.
 
 rl__default_temporary_state(ModuleInfo, TmpState) :-
@@ -637,6 +664,271 @@
 rl__relation_id_to_string(RelationId, Str) :-
 	string__int_to_string(RelationId, Str0),
 	string__append("Rel", Str0, Str).
+
+%-----------------------------------------------------------------------------%
+
+
+rl__schemas_to_strings(ModuleInfo, SchemaList, TypeDecls, SchemaStrings) :-
+	map__init(GatheredTypes0),
+	set__init(RecursiveTypes0),
+	rl__schemas_to_strings_2(ModuleInfo, GatheredTypes0, RecursiveTypes0,
+		SchemaList, "", TypeDecls, [], SchemaStrings).
+
+:- pred rl__schemas_to_strings_2(module_info::in, gathered_types::in,
+	set(full_type_id)::in, list(list(type))::in,
+	string::in, string::out, list(string)::in, list(string)::out) is det.
+
+rl__schemas_to_strings_2(_, _, _, [], TypeDecls, TypeDecls,
+		SchemaStrings0, SchemaStrings) :-
+	list__reverse(SchemaStrings0, SchemaStrings).
+rl__schemas_to_strings_2(ModuleInfo, GatheredTypes0, RecursiveTypes0,
+		[Schema0 | Schemas], TypeDecls0, TypeDecls,
+		SchemaStrings0, SchemaStrings) :-
+	strip_prog_contexts(Schema0, Schema),
+	set__init(Parents0),
+	rl__gather_types(ModuleInfo, Parents0, Schema,
+		GatheredTypes0, GatheredTypes1,
+		RecursiveTypes0, RecursiveTypes1,
+		TypeDecls0, TypeDecls1,
+		"", SchemaString),
+	rl__schemas_to_strings_2(ModuleInfo, GatheredTypes1, RecursiveTypes1,
+		Schemas, TypeDecls1, TypeDecls,
+		[SchemaString | SchemaStrings0], SchemaStrings).
+
+rl__schema_to_string(ModuleInfo, Types0, SchemaString) :-
+	map__init(GatheredTypes0),
+	set__init(RecursiveTypes0),
+	set__init(Parents0),
+	strip_prog_contexts(Types0, Types),
+	rl__gather_types(ModuleInfo, Parents0, Types,
+		GatheredTypes0, _, RecursiveTypes0, _, "", Decls,
+		"", SchemaString0),
+	string__append_list([Decls, "(", SchemaString0, ")"], SchemaString).
+
+	% Map from type to name and type definition string
+:- type gathered_types == map(pair(type_id, list(type)), string).
+:- type full_type_id == pair(type_id, list(type)).
+
+	% Go over a list of types collecting declarations for all the
+	% types used in the list.
+:- pred rl__gather_types(module_info::in, set(full_type_id)::in, 
+		list(type)::in, gathered_types::in, gathered_types::out, 
+		set(full_type_id)::in, set(full_type_id)::out, 
+		string::in, string::out, string::in, string::out) is det.
+
+rl__gather_types(_, _, [], GatheredTypes, GatheredTypes, 
+		RecursiveTypes, RecursiveTypes, Decls, Decls,
+		TypeString, TypeString).
+rl__gather_types(ModuleInfo, Parents, [Type | Types], GatheredTypes0, 
+		GatheredTypes, RecursiveTypes0, RecursiveTypes, 
+		Decls0, Decls, TypeString0, TypeString) :-
+	rl__gather_type(ModuleInfo, Parents, Type, GatheredTypes0,
+		GatheredTypes1, RecursiveTypes0, RecursiveTypes1,
+		Decls0, Decls1, ThisTypeString),
+	( Types = [] ->
+		Comma = ""
+	;
+		Comma = ","
+	),
+	string__append_list([TypeString0, ThisTypeString, Comma], TypeString1),
+	rl__gather_types(ModuleInfo, Parents, Types, GatheredTypes1, 
+		GatheredTypes, RecursiveTypes1, RecursiveTypes, 
+		Decls1, Decls, TypeString1, TypeString).
+
+:- pred rl__gather_type(module_info::in, set(full_type_id)::in, (type)::in, 
+		gathered_types::in, gathered_types::out, set(full_type_id)::in, 
+		set(full_type_id)::out, string::in, string::out,
+		string::out) is det.
+
+rl__gather_type(ModuleInfo, Parents, Type, GatheredTypes0, GatheredTypes, 
+		RecursiveTypes0, RecursiveTypes, Decls0, Decls, ThisType) :-
+	classify_type(Type, ModuleInfo, ClassifiedType0),
+	( ClassifiedType0 = enum_type ->
+		ClassifiedType = user_type
+	;
+		ClassifiedType = ClassifiedType0
+	),
+	(
+		ClassifiedType = enum_type,
+			% this is converted to user_type above
+		error("rl__gather_type: enum type")
+	;
+		ClassifiedType = polymorphic_type,
+		error("rl__gather_type: polymorphic type")
+	;
+		ClassifiedType = char_type,
+		GatheredTypes = GatheredTypes0,
+		RecursiveTypes = RecursiveTypes0,
+		Decls = Decls0,
+		ThisType = ":I"
+	;
+		ClassifiedType = int_type,
+		GatheredTypes = GatheredTypes0,
+		RecursiveTypes = RecursiveTypes0,
+		Decls = Decls0,
+		ThisType = ":I"
+	;
+		ClassifiedType = float_type,
+		GatheredTypes = GatheredTypes0,
+		RecursiveTypes = RecursiveTypes0,
+		Decls = Decls0,
+		ThisType = ":D"
+	;
+		ClassifiedType = str_type,
+		GatheredTypes = GatheredTypes0,
+		RecursiveTypes = RecursiveTypes0,
+		Decls = Decls0,
+		ThisType = ":S"
+	;
+		ClassifiedType = pred_type,
+		error("rl__gather_type: pred type")
+	;
+		ClassifiedType = user_type,
+		(
+			type_to_type_id(Type, TypeId, Args),
+		 	type_constructors(Type, ModuleInfo, Ctors)
+		->
+			( set__member(TypeId - Args, Parents) ->
+				set__insert(RecursiveTypes0, TypeId - Args,
+					RecursiveTypes1)
+			;
+				RecursiveTypes1 = RecursiveTypes0
+			),
+			(
+				map__search(GatheredTypes0, TypeId - Args,
+					MangledTypeName0) 
+			->
+				GatheredTypes = GatheredTypes0,
+				Decls = Decls0,
+				MangledTypeName = MangledTypeName0,
+				RecursiveTypes = RecursiveTypes1
+			;
+				set__insert(Parents, TypeId - Args,
+					Parents1),
+				rl__mangle_and_quote_type_name(TypeId,
+					Args, MangledTypeName),
+
+				% Record that we have seen this type
+				% before processing the sub-terms.
+				map__det_insert(GatheredTypes0, TypeId - Args,
+					MangledTypeName, GatheredTypes1),
+
+				rl__gather_constructors(ModuleInfo, 
+					Parents1, Ctors, GatheredTypes1, 
+					GatheredTypes, RecursiveTypes1,
+					RecursiveTypes, Decls0, Decls1, 
+					"", CtorDecls),
+
+				% Recursive types are marked by a
+				% second colon before their declaration.
+				( set__member(TypeId - Args, RecursiveTypes) ->
+					RecursiveSpec = ":"
+				;
+					RecursiveSpec = ""
+				),
+				string__append_list(
+					[Decls1, RecursiveSpec, ":",
+					MangledTypeName, "=", CtorDecls, " "],
+					Decls)	
+			),
+			string__append(":T", MangledTypeName, ThisType)
+		;
+			error("rl__gather_type: type_constructors failed")
+		)
+	).
+
+:- pred rl__gather_constructors(module_info::in, set(full_type_id)::in,
+		list(constructor)::in, map(full_type_id, string)::in, 
+		map(full_type_id, string)::out, set(full_type_id)::in, 
+		set(full_type_id)::out, string::in, string::out,
+		string::in, string::out) is det.
+				
+rl__gather_constructors(_, _, [], GatheredTypes, GatheredTypes, 
+		RecursiveTypes, RecursiveTypes, Decls, Decls, 
+		CtorDecls, CtorDecls).
+rl__gather_constructors(ModuleInfo, Parents, [Ctor | Ctors],
+		GatheredTypes0, GatheredTypes, RecursiveTypes0, RecursiveTypes,
+		Decls0, Decls, CtorDecls0, CtorDecls) :-
+	Ctor = ctor(_, _, CtorName, Args),
+	list__length(Args, Arity),
+	rl__mangle_and_quote_ctor_name(CtorName, Arity, MangledCtorName),
+
+	Snd = lambda([Pair::in, Second::out] is det, Pair = _ - Second),
+	list__map(Snd, Args, ArgTypes),
+	rl__gather_types(ModuleInfo, Parents, ArgTypes, GatheredTypes0, 
+		GatheredTypes1, RecursiveTypes0, RecursiveTypes1, 
+		Decls0, Decls1, "", ArgList),
+	( Ctors = [] ->
+		Sep = ""
+	;
+		Sep = "|"
+	),
+	% Note that [] should be output as '[]'().
+	string__append_list(
+		[CtorDecls0, MangledCtorName, "(", ArgList, ")", Sep],
+		CtorDecls1),
+	rl__gather_constructors(ModuleInfo, Parents, Ctors,
+		GatheredTypes1, GatheredTypes, RecursiveTypes1, RecursiveTypes,
+		Decls1, Decls, CtorDecls1, CtorDecls).
+
+%-----------------------------------------------------------------------------%
+
+rl__mangle_and_quote_type_name(TypeId, Args, MangledTypeName) :-
+	rl__mangle_type_name(TypeId, Args, MangledTypeName0),
+	rl__maybe_quote_name(MangledTypeName0, MangledTypeName).
+
+rl__mangle_type_name(TypeId, Args, MangledTypeName) :-
+	rl__mangle_type_name_2(TypeId, Args, "", MangledTypeName).
+
+:- pred rl__mangle_type_name_2(type_id::in, list(type)::in,
+		string::in, string::out) is det.
+
+rl__mangle_type_name_2(TypeId, Args, MangledTypeName0, MangledTypeName) :-
+	( 
+		TypeId = qualified(Module0, Name) - Arity,
+		prog_out__sym_name_to_string(Module0, Module),
+		string__append_list([MangledTypeName0, Module, "__", Name], 
+			MangledTypeName1)
+	;
+		TypeId = unqualified(TypeName) - Arity,
+		string__append(MangledTypeName0, TypeName, MangledTypeName1)
+	),
+	string__int_to_string(Arity, ArStr),
+	string__append_list([MangledTypeName1, "___", ArStr], 
+		MangledTypeName2),
+	( Args = [] ->
+		MangledTypeName = MangledTypeName2
+	;
+		list__foldl(rl__mangle_type_arg, Args, 
+			MangledTypeName2, MangledTypeName)
+	).
+
+:- pred rl__mangle_type_arg((type)::in, string::in, string::out) is det.
+
+rl__mangle_type_arg(Arg, String0, String) :-
+	string__append(String0, "___", String1),
+	( type_to_type_id(Arg, ArgTypeId, ArgTypeArgs) ->
+		rl__mangle_type_name_2(ArgTypeId, ArgTypeArgs, 
+			String1, String)
+	;
+		error("rl__mangle_type_arg: type_to_type_id failed")
+	).
+
+rl__mangle_ctor_name(CtorName, _Arity, MangledCtorName) :-
+	unqualify_name(CtorName, MangledCtorName).
+
+rl__mangle_and_quote_ctor_name(CtorName, Arity, MangledCtorName) :-
+	rl__mangle_ctor_name(CtorName, Arity, MangledCtorName0),
+	rl__maybe_quote_name(MangledCtorName0, MangledCtorName).
+
+:- pred rl__maybe_quote_name(string::in, string::out) is det.
+
+rl__maybe_quote_name(Name0, Name) :-
+	( string__is_alnum_or_underscore(Name0) ->
+		Name = Name0
+	;
+		string__append_list(["'", Name0, "'"], Name)
+	).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/rl_exprn.m,v
retrieving revision 1.2
diff -u -u -r1.2 rl_exprn.m
--- rl_exprn.m	1999/03/22 08:07:41	1.2
+++ rl_exprn.m	1999/03/31 06:16:14
@@ -5,6 +5,8 @@
 %-----------------------------------------------------------------------------%
 % File: rl_exprn.m
 % Main author: stayl
+%
+% This module should only be imported by rl_out.m. XXX make it a sub-module.
 % 
 % Generate RL "expressions" to evaluate join conditions.
 % 
@@ -1099,8 +1101,8 @@
 	->
 		% These names should not be quoted, since they are not
 		% being parsed, just compared against other strings.
-		{ rl_out__mangle_type_name(TypeId, Args, MangledTypeName) },
-		{ rl_out__mangle_ctor_name(ConsName, Arity, MangledConsName) },
+		{ rl__mangle_type_name(TypeId, Args, MangledTypeName) },
+		{ rl__mangle_ctor_name(ConsName, Arity, MangledConsName) },
 		{ Rule = rl_rule(MangledTypeName, MangledConsName, Arity) },
 		rl_exprn_info_lookup_rule(Rule - ExprnTuple, RuleNo)
 	;
Index: compiler/rl_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/rl_gen.m,v
retrieving revision 1.2
diff -u -u -r1.2 rl_gen.m
--- rl_gen.m	1999/03/18 00:55:07	1.2
+++ rl_gen.m	1999/03/31 04:49:00
@@ -32,7 +32,7 @@
 
 :- import_module code_aux, code_util, det_analysis, hlds_data, hlds_goal.
 :- import_module instmap, llds_out, mode_util, prog_data, prog_out.
-:- import_module rl_relops, rl_info, rl_out.
+:- import_module rl_relops, rl_info.
 :- import_module tree, type_util, dependency_graph.
 :- import_module inst_match, (inst), goal_util, inlining, globals, options.
 
Index: compiler/rl_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/rl_out.m,v
retrieving revision 1.5
diff -u -u -r1.5 rl_out.m
--- rl_out.m	1999/03/19 04:47:39	1.5
+++ rl_out.m	1999/04/01 05:22:45
@@ -11,12 +11,18 @@
 % See $ADITI_ROOT/src/rosi/rlo_spec.tex for a partial specification 
 % of the bytecodes. (copy in ~stayl/aditi/src/rosi/rlo_spec.tex)
 %
+% Be sure not to add unnecessary dependencies on this module, since
+% compiling the code in rl_code.m is very inefficient in the alias branch.
+% Any dependencies there are should be in `.pp' files bracketed by
+% #ifdef INCLUDE_ADITI_OUTPUT ... #else ... #endif
+% as in mercury_compile.pp and rl_file.pp.
+%
 %-----------------------------------------------------------------------------%
 :- module rl_out.
 
 :- interface.
 
-:- import_module rl, rl_code, rl_file, hlds_data, hlds_module, prog_data, tree.
+:- import_module rl, rl_code, rl_file, hlds_module, tree.
 :- import_module list, io, std_util.
 
 	% Output schemas for locally defined base and derived relations to
@@ -33,35 +39,18 @@
 :- pred rl_out__generate_rl_bytecode(module_info::in, list(rl_proc)::in, 
 		maybe(rl_file)::out, io__state::di, io__state::uo) is det.
 
-	% Convert a list of types to a schema string.
-:- pred rl_out__schema_to_string(module_info::in,
-		list(type)::in, string::out) is det.
-
 	% Given a predicate to update the labels in a bytecode, update
 	% all the labels in a tree of bytecodes.
 :- pred rl_out__resolve_addresses(pred(bytecode, bytecode),
 		byte_tree, byte_tree). 
 :- mode rl_out__resolve_addresses(pred(in, out) is det, in, out) is det.
-			
-	% Produce names acceptable to Aditi (just wrap single
-	% quotes around non-alphanumeric-and-underscore names).
-:- pred rl_out__mangle_and_quote_type_name(type_id::in, list(type)::in,
-		string::out) is det.
-:- pred rl_out__mangle_and_quote_ctor_name(sym_name::in,
-		int::in, string::out) is det.
-
-	% The expression stuff expects that constructor
-	% and type names are unquoted.
-:- pred rl_out__mangle_type_name(type_id::in, list(type)::in,
-		string::out) is det.
-:- pred rl_out__mangle_ctor_name(sym_name::in, int::in, string::out) is det.
 
 :- type byte_tree == tree(list(bytecode)).
 
 %-----------------------------------------------------------------------------%
 :- implementation.
 
-:- import_module code_util, hlds_data, hlds_pred, prog_out.
+:- import_module code_util, hlds_data, hlds_pred, prog_data, prog_out.
 :- import_module llds, globals, options, rl_code, tree, type_util, passes_aux.
 :- import_module rl_exprn, rl_file, getopt, modules, prog_util, magic_util.
 :- import_module assoc_list, bool, char, int, map, multi_map, require, set.
@@ -466,7 +455,7 @@
 	string__format("%s__%i", [s(PredName), i(PredArity)], RelName),
 	pred_info_arg_types(PredInfo, ArgTypes0),
 	magic_util__remove_aditi_state(ArgTypes0, ArgTypes0, ArgTypes),
-	rl_out__schema_to_string(ModuleInfo, ArgTypes, SchemaString).
+	rl__schema_to_string(ModuleInfo, ArgTypes, SchemaString).
 
 %-----------------------------------------------------------------------------%
 
@@ -498,43 +487,45 @@
 		list(relation_id)::in, string::out) is det.
 
 rl_out__get_proc_schema(ModuleInfo, Relations, Args, SchemaString) :- 
-	map__init(GatheredTypes0),
-	set__init(RecursiveTypes0),
-	rl_out__generate_proc_schema_2(ModuleInfo, Relations, 1, Args,
-		GatheredTypes0, RecursiveTypes0, "", Decls, "", SchemaList),
-	string__append_list([Decls, "(", SchemaList, ")"], SchemaString).
-
-:- pred rl_out__generate_proc_schema_2(module_info::in, relation_info_map::in,
-		int::in, list(relation_id)::in, gathered_types::in,
-		set(full_type_id)::in, string::in, string::out, string::in,
-		string::out) is det.
-
-rl_out__generate_proc_schema_2(_, _, _, [], _, _, Decls, Decls, 
-		SchemaList, SchemaList). 
-rl_out__generate_proc_schema_2(ModuleInfo, RelInfoMap, ArgNo, [Arg | Args],
-		GatheredTypes0, RecursiveTypes0, Decls0, Decls,
-		SchemaList0, SchemaList) :-
-	map__lookup(RelInfoMap, Arg, ArgInfo),
-	ArgInfo = relation_info(_, ArgSchema, _, _),
-	set__init(Parents),
-	rl_out__gather_types(ModuleInfo, Parents, ArgSchema, 
-		GatheredTypes0, GatheredTypes, RecursiveTypes0, RecursiveTypes,
-		Decls0, Decls1, "", ArgRelSchema),
-	string__int_to_string(ArgNo, ArgString),
+	list__map(
+		(pred(Arg::in, ArgSchema::out) is det :-
+			map__lookup(Relations, Arg, ArgInfo),
+			ArgInfo = relation_info(_, ArgSchema, _, _)
+		), Args, ArgSchemas),
+	rl__schemas_to_strings(ModuleInfo, ArgSchemas,
+		TypeDecls, ArgSchemaStrings),
+	list__map_foldl(
+		(pred(ArgSchemaString::in, ArgSchemaDecl::out,
+				Index::in, (Index + 1)::out) is det :-
+			ArgPrefix = "__arg_",
+			string__int_to_string(Index, ArgString),
+			string__append_list(
+				[":", ArgPrefix, ArgString, "=",
+				ArgPrefix, ArgString, "(",
+				ArgSchemaString, ") "],
+				ArgSchemaDecl)
+		), ArgSchemaStrings, ArgSchemaDeclList, 1, _),
+	rl_out__generate_proc_schema_2(1, Args, "", SchemaString0),
+	list__condense([[TypeDecls | ArgSchemaDeclList], ["("],
+		[SchemaString0, ")"]], SchemaStrings),
+	string__append_list(SchemaStrings, SchemaString).
+
+:- pred rl_out__generate_proc_schema_2(int::in, list(T)::in,
+		string::in, string::out) is det.
+
+rl_out__generate_proc_schema_2(_, [], SchemaList, SchemaList). 
+rl_out__generate_proc_schema_2(ArgNo, [_ | Args], SchemaList0, SchemaList) :-
 	ArgPrefix = "__arg_",
-	string__append_list([Decls1, ":", ArgPrefix, ArgString, "=",
-		ArgPrefix, ArgString, "(", ArgRelSchema, ") "], Decls2),
-	NextArg = ArgNo + 1,
 	( Args = [] ->
 		Comma = ""
 	;
 		Comma = ","
 	),
+	string__int_to_string(ArgNo, ArgString),
 	string__append_list([SchemaList0, ":T", ArgPrefix, ArgString, Comma],
 		SchemaList1),
-	rl_out__generate_proc_schema_2(ModuleInfo, RelInfoMap, NextArg, Args,
-		GatheredTypes, RecursiveTypes, Decls2, Decls,
-		SchemaList1, SchemaList).
+	rl_out__generate_proc_schema_2(ArgNo + 1,
+		Args, SchemaList1, SchemaList).
 
 %-----------------------------------------------------------------------------%
 
@@ -546,244 +537,9 @@
 
 rl_out__schema_to_string(Types, SchemaOffset) -->
 	rl_out_info_get_module_info(ModuleInfo),
-	{ rl_out__schema_to_string(ModuleInfo, Types, SchemaString) },
+	{ rl__schema_to_string(ModuleInfo, Types, SchemaString) },
 	rl_out_info_assign_const(string(SchemaString), SchemaOffset).
 
-rl_out__schema_to_string(ModuleInfo, Types0, SchemaString) :-
-	map__init(GatheredTypes0),
-	set__init(RecursiveTypes0),
-	set__init(Parents0),
-	strip_prog_contexts(Types0, Types),
-	rl_out__gather_types(ModuleInfo, Parents0, Types,
-		GatheredTypes0, _, RecursiveTypes0, _, "", Decls,
-		"", SchemaList),
-	string__append_list([Decls, "(", SchemaList, ")"], SchemaString).
-
-	% Map from type to name and type definition string
-:- type gathered_types == map(pair(type_id, list(type)), string).
-:- type full_type_id == pair(type_id, list(type)).
-
-	% Go over a list of types collecting declarations for all the
-	% types used in the list.
-:- pred rl_out__gather_types(module_info::in, set(full_type_id)::in, 
-		list(type)::in, gathered_types::in, gathered_types::out, 
-		set(full_type_id)::in, set(full_type_id)::out, 
-		string::in, string::out, string::in, string::out) is det.
-
-rl_out__gather_types(_, _, [], GatheredTypes, GatheredTypes, 
-		RecursiveTypes, RecursiveTypes, Decls, Decls,
-		TypeString, TypeString).
-rl_out__gather_types(ModuleInfo, Parents, [Type | Types], GatheredTypes0, 
-		GatheredTypes, RecursiveTypes0, RecursiveTypes, 
-		Decls0, Decls, TypeString0, TypeString) :-
-	rl_out__gather_type(ModuleInfo, Parents, Type, GatheredTypes0,
-		GatheredTypes1, RecursiveTypes0, RecursiveTypes1,
-		Decls0, Decls1, ThisTypeString),
-	( Types = [] ->
-		Comma = ""
-	;
-		Comma = ","
-	),
-	string__append_list([TypeString0, ThisTypeString, Comma], TypeString1),
-	rl_out__gather_types(ModuleInfo, Parents, Types, GatheredTypes1, 
-		GatheredTypes, RecursiveTypes1, RecursiveTypes, 
-		Decls1, Decls, TypeString1, TypeString).
-
-:- pred rl_out__gather_type(module_info::in, set(full_type_id)::in, (type)::in, 
-		gathered_types::in, gathered_types::out, set(full_type_id)::in, 
-		set(full_type_id)::out, string::in, string::out,
-		string::out) is det.
-
-rl_out__gather_type(ModuleInfo, Parents, Type, GatheredTypes0, GatheredTypes, 
-		RecursiveTypes0, RecursiveTypes, Decls0, Decls, ThisType) :-
-	classify_type(Type, ModuleInfo, ClassifiedType0),
-	( ClassifiedType0 = enum_type ->
-		ClassifiedType = user_type
-	;
-		ClassifiedType = ClassifiedType0
-	),
-	(
-		ClassifiedType = enum_type,
-			% this is converted to user_type above
-		error("rl_out__gather_type: enum type")
-	;
-		ClassifiedType = polymorphic_type,
-		error("rl_out__gather_type: polymorphic type")
-	;
-		ClassifiedType = char_type,
-		GatheredTypes = GatheredTypes0,
-		RecursiveTypes = RecursiveTypes0,
-		Decls = Decls0,
-		ThisType = ":I"
-	;
-		ClassifiedType = int_type,
-		GatheredTypes = GatheredTypes0,
-		RecursiveTypes = RecursiveTypes0,
-		Decls = Decls0,
-		ThisType = ":I"
-	;
-		ClassifiedType = float_type,
-		GatheredTypes = GatheredTypes0,
-		RecursiveTypes = RecursiveTypes0,
-		Decls = Decls0,
-		ThisType = ":D"
-	;
-		ClassifiedType = str_type,
-		GatheredTypes = GatheredTypes0,
-		RecursiveTypes = RecursiveTypes0,
-		Decls = Decls0,
-		ThisType = ":S"
-	;
-		ClassifiedType = pred_type,
-		error("rl_out__gather_type: pred type")
-	;
-		ClassifiedType = user_type,
-		(
-			type_to_type_id(Type, TypeId, Args),
-		 	type_constructors(Type, ModuleInfo, Ctors)
-		->
-			( set__member(TypeId - Args, Parents) ->
-				set__insert(RecursiveTypes0, TypeId - Args,
-					RecursiveTypes1)
-			;
-				RecursiveTypes1 = RecursiveTypes0
-			),
-			(
-				map__search(GatheredTypes0, TypeId - Args,
-					MangledTypeName0) 
-			->
-				GatheredTypes = GatheredTypes0,
-				Decls = Decls0,
-				MangledTypeName = MangledTypeName0,
-				RecursiveTypes = RecursiveTypes1
-			;
-				set__insert(Parents, TypeId - Args,
-					Parents1),
-				rl_out__mangle_and_quote_type_name(TypeId,
-					Args, MangledTypeName),
-
-				% Record that we have seen this type
-				% before processing the sub-terms.
-				map__det_insert(GatheredTypes0, TypeId - Args,
-					MangledTypeName, GatheredTypes1),
-
-				rl_out__gather_constructors(ModuleInfo, 
-					Parents1, Ctors, GatheredTypes1, 
-					GatheredTypes, RecursiveTypes1,
-					RecursiveTypes, Decls0, Decls1, 
-					"", CtorDecls),
-
-				% Recursive types are marked by a
-				% second colon before their declaration.
-				( set__member(TypeId - Args, RecursiveTypes) ->
-					RecursiveSpec = ":"
-				;
-					RecursiveSpec = ""
-				),
-				string__append_list(
-					[Decls1, RecursiveSpec, ":",
-					MangledTypeName, "=", CtorDecls, " "],
-					Decls)	
-			),
-			string__append(":T", MangledTypeName, ThisType)
-		;
-			error("rl_out__gather_type: type_constructors failed")
-		)
-	).
-
-:- pred rl_out__gather_constructors(module_info::in, set(full_type_id)::in,
-		list(constructor)::in, map(full_type_id, string)::in, 
-		map(full_type_id, string)::out, set(full_type_id)::in, 
-		set(full_type_id)::out, string::in, string::out,
-		string::in, string::out) is det.
-				
-rl_out__gather_constructors(_, _, [], GatheredTypes, GatheredTypes, 
-		RecursiveTypes, RecursiveTypes, Decls, Decls, 
-		CtorDecls, CtorDecls).
-rl_out__gather_constructors(ModuleInfo, Parents, [Ctor | Ctors],
-		GatheredTypes0, GatheredTypes, RecursiveTypes0, RecursiveTypes,
-		Decls0, Decls, CtorDecls0, CtorDecls) :-
-	Ctor = ctor(_, _, CtorName, Args),
-	list__length(Args, Arity),
-	rl_out__mangle_and_quote_ctor_name(CtorName, Arity, MangledCtorName),
-
-	Snd = lambda([Pair::in, Second::out] is det, Pair = _ - Second),
-	list__map(Snd, Args, ArgTypes),
-	rl_out__gather_types(ModuleInfo, Parents, ArgTypes, GatheredTypes0, 
-		GatheredTypes1, RecursiveTypes0, RecursiveTypes1, 
-		Decls0, Decls1, "", ArgList),
-	( Ctors = [] ->
-		Sep = ""
-	;
-		Sep = "|"
-	),
-	% Note that [] should be output as '[]'().
-	string__append_list(
-		[CtorDecls0, MangledCtorName, "(", ArgList, ")", Sep],
-		CtorDecls1),
-	rl_out__gather_constructors(ModuleInfo, Parents, Ctors,
-		GatheredTypes1, GatheredTypes, RecursiveTypes1, RecursiveTypes,
-		Decls1, Decls, CtorDecls1, CtorDecls).
-
-%-----------------------------------------------------------------------------%
-
-rl_out__mangle_and_quote_type_name(TypeId, Args, MangledTypeName) :-
-	rl_out__mangle_type_name(TypeId, Args, MangledTypeName0),
-	rl_out__maybe_quote_name(MangledTypeName0, MangledTypeName).
-
-rl_out__mangle_type_name(TypeId, Args, MangledTypeName) :-
-	rl_out__mangle_type_name_2(TypeId, Args, "", MangledTypeName).
-
-:- pred rl_out__mangle_type_name_2(type_id::in, list(type)::in,
-		string::in, string::out) is det.
-
-rl_out__mangle_type_name_2(TypeId, Args, MangledTypeName0, MangledTypeName) :-
-	( 
-		TypeId = qualified(Module0, Name) - Arity,
-		prog_out__sym_name_to_string(Module0, Module),
-		string__append_list([MangledTypeName0, Module, "__", Name], 
-			MangledTypeName1)
-	;
-		TypeId = unqualified(TypeName) - Arity,
-		string__append(MangledTypeName0, TypeName, MangledTypeName1)
-	),
-	string__int_to_string(Arity, ArStr),
-	string__append_list([MangledTypeName1, "___", ArStr], 
-		MangledTypeName2),
-	( Args = [] ->
-		MangledTypeName = MangledTypeName2
-	;
-		list__foldl(rl_out__mangle_type_arg, Args, 
-			MangledTypeName2, MangledTypeName)
-	).
-
-:- pred rl_out__mangle_type_arg((type)::in, string::in, string::out) is det.
-
-rl_out__mangle_type_arg(Arg, String0, String) :-
-	string__append(String0, "___", String1),
-	( type_to_type_id(Arg, ArgTypeId, ArgTypeArgs) ->
-		rl_out__mangle_type_name_2(ArgTypeId, ArgTypeArgs, 
-			String1, String)
-	;
-		error("rl_out__mangle_type_arg: type_to_type_id failed")
-	).
-
-rl_out__mangle_ctor_name(CtorName, _Arity, MangledCtorName) :-
-	unqualify_name(CtorName, MangledCtorName).
-
-rl_out__mangle_and_quote_ctor_name(CtorName, Arity, MangledCtorName) :-
-	rl_out__mangle_ctor_name(CtorName, Arity, MangledCtorName0),
-	rl_out__maybe_quote_name(MangledCtorName0, MangledCtorName).
-
-:- pred rl_out__maybe_quote_name(string::in, string::out) is det.
-
-rl_out__maybe_quote_name(Name0, Name) :-
-	( string__is_alnum_or_underscore(Name0) ->
-		Name = Name0
-	;
-		string__append_list(["'", Name0, "'"], Name)
-	).
-
 %-----------------------------------------------------------------------------%
 
 :- pred rl_out__generate_instr_list(list(rl_instruction)::in, byte_tree::out,
@@ -1752,13 +1508,6 @@
 						% to list of variables.
 						% These must only be used 
 						% within one rl.m instruction.
-	).
-
-:- type rl_rule
-	---> rl_rule(
-		string,		% mangled type name 
-		string,		% mangled functor name 
-		int		% arity
 	).
 
 	% We only want to generate a single comparison expression for

--- mercury_compile.m	Wed Apr 14 16:28:55 1999
+++ mercury_compile.pp	Wed Mar 31 17:23:46 1999
@@ -40,7 +40,11 @@
 :- import_module lco, saved_vars, liveness.
 :- import_module follow_code, live_vars, arg_info, store_alloc, goal_path.
 :- import_module code_gen, optimize, export, base_type_info, base_type_layout.
-:- import_module rl_gen, rl_opt, rl_out.
+:- import_module rl_gen, rl_opt.
+#if INCLUDE_ADITI_OUTPUT	% See ../Mmake.common.in.
+:- import_module rl_out.
+#else
+#endif
 :- import_module llds_common, transform_llds, llds_out.
 :- import_module continuation_info, stack_layout.
 
@@ -414,13 +418,8 @@
 		% magic sets can report errors.
 		{ module_info_num_errors(HLDS50, NumErrors) },
 		( { NumErrors = 0 } ->
-		    { module_info_get_do_aditi_compilation(HLDS50, Aditi) },
-		    ( { Aditi = do_aditi_compilation } ->
-			mercury_compile__generate_rl_bytecode(HLDS50,
-				Verbose, MaybeRLFile)
-		    ;
-			{ MaybeRLFile = no }
-		    ),
+		    mercury_compile__generate_rl_bytecode(HLDS50,
+			Verbose, MaybeRLFile),
 		    ( { AditiOnly = yes } ->
 		    	[]
 		    ; { HighLevelC = yes } ->
@@ -1035,13 +1034,24 @@
 :- mode mercury_compile__generate_rl_bytecode(in, in, out, di, uo) is det.
 
 mercury_compile__generate_rl_bytecode(ModuleInfo, Verbose, MaybeRLFile) -->
-	maybe_write_string(Verbose, "% Generating RL...\n"),
-	maybe_flush_output(Verbose),
-	rl_gen__module(ModuleInfo, RLProcs0),
-	mercury_compile__maybe_dump_rl(RLProcs0, ModuleInfo, "", ""),
-	rl_opt__procs(ModuleInfo, RLProcs0, RLProcs),
-	mercury_compile__maybe_dump_rl(RLProcs, ModuleInfo, "", ".opt"),
-	rl_out__generate_rl_bytecode(ModuleInfo, RLProcs, MaybeRLFile).
+	{ module_info_get_do_aditi_compilation(ModuleInfo, Aditi) },
+	( { Aditi = do_aditi_compilation } ->
+		maybe_write_string(Verbose, "% Generating RL...\n"),
+		maybe_flush_output(Verbose),
+		rl_gen__module(ModuleInfo, RLProcs0),
+		mercury_compile__maybe_dump_rl(RLProcs0, ModuleInfo, "", ""),
+		rl_opt__procs(ModuleInfo, RLProcs0, RLProcs),
+		mercury_compile__maybe_dump_rl(RLProcs,
+			ModuleInfo, "", ".opt"),
+#if INCLUDE_ADITI_OUTPUT	% See ../Mmake.common.in.
+		rl_out__generate_rl_bytecode(ModuleInfo, RLProcs, MaybeRLFile)
+#else
+		{ error(
+	"mercury_compile.pp: `--aditi' requires `INCLUDE_ADITI_OUTPUT'") }
+#endif
+	;
+		{ MaybeRLFile = no }
+	).
 
 %-----------------------------------------------------------------------------%
 
@@ -1517,8 +1527,14 @@
 	globals__io_lookup_bool_option(generate_schemas, Generate),
 	( { Generate = yes } ->
 		maybe_write_string(Verbose, "% Writing schema file..."),
+#if INCLUDE_ADITI_OUTPUT	% See ../Mmake.common.in.
 		rl_out__generate_schema_file(ModuleInfo),
 		maybe_write_string(Verbose, " done.\n")
+#else 
+		{ module_info_incr_errors(ModuleInfo, _) },
+		{ error(
+"mercury_compile.pp: `--generate-schemas' requires `INCLUDE_ADITI_OUTPUT'") }
+#endif
 	;
 		[]
 	).
--- rl_file.m	Wed Apr 14 16:29:03 1999
+++ rl_file.pp	Wed Mar 31 17:23:46 1999
@@ -13,8 +13,7 @@
 
 :- interface.
 
-:- import_module rl_code.
-:- import_module assoc_list, io, list.
+:- import_module io.
 
 :- type byte_writer == (pred(int, io__state, io__state)).
 :- mode byte_writer :: (pred(in, di, uo) is det).
@@ -25,6 +24,10 @@
 :- pred rl_file__write_binary(byte_writer::byte_writer, rl_file::in, 
 		int::out, io__state::di, io__state::uo) is det. 
 
+#if INCLUDE_ADITI_OUTPUT	% See ../Mmake.common.in.
+:- import_module rl_code.
+:- import_module assoc_list, list.
+
 	% Write a text representation of an RL file to the current
 	% text stream output.
 :- pred rl_file__write_text(rl_file::in, io__state::di, io__state::uo) is det.
@@ -105,7 +108,11 @@
 	;	generate2	% generates two output tuples - used for
 				% B-tree key ranges.
 	.
+#else
+:- import_module std_util.
 
+:- type rl_file == unit.
+#endif
 %-----------------------------------------------------------------------------%
 :- implementation.
 
@@ -119,6 +126,7 @@
 	% 
 	% Write the binary representation of the file to <module>.rlo.
 	%
+#if INCLUDE_ADITI_OUTPUT	% See ../Mmake.common.in.
 rl_file__write_binary(ByteWriter, RLFile, Length, IO0, IO) :-
 	Writer =
 	    lambda([Byte::in, Pair0::di, Pair::uo] is det, (
@@ -130,7 +138,17 @@
 	State0 = 0 - IO0,
 	rl_file__write_binary_2(Writer, RLFile, State0, State),
 	State = Length - IO.
+#else
+rl_file__write_binary(_ByteWriter, _RLFile, Length, IO0, IO) :-
+	( semidet_succeed ->
+		error("rl_file.pp: `--aditi' requires `INCLUDE_ADITI_OUTPUT'")
+	;
+		Length = 0,
+		IO = IO0
+	).
+#endif
 
+#if INCLUDE_ADITI_OUTPUT	% See ../Mmake.common.in.
 :- pred rl_file__write_binary_2(writer::writer, rl_file::in, 
 		rl_state::di, rl_state::uo) is det. 
 
@@ -492,3 +510,5 @@
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
+#else	/* !INCLUDE_ADITI_OUTPUT */
+#endif