mercury/compiler/rl.m

%-----------------------------------------------------------------------------%
% Copyright (C) 1998-2000 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
% File: rl.m
% Main author: stayl
%
% Intermediate form used for optimization of Aditi-RL code.
%
% Generated by rl_gen.m.
% Human readable debugging output by rl_dump.m.
% Output to RL bytecodes by rl_out.m.
%
%-----------------------------------------------------------------------------%
:- module rl. 

:- interface.

:- import_module hlds_data, hlds_goal, hlds_module, hlds_pred.
:- import_module instmap, prog_data.
:- import_module assoc_list, list, std_util, map, set.

%-----------------------------------------------------------------------------%

:- type rl_code		==	list(rl_proc).

:- type rl_proc	
	---> rl_proc(
		rl_proc_name,
		list(relation_id),	% input argument relations
		list(relation_id),	% output argument relations
		set(relation_id),	% memoed relations
		relation_info_map,	% all relations used by the procedure
		list(rl_instruction),
		list(pred_proc_id)	% list of Mercury procedures contained
					% in this RL procedure
	).

:- type rl_proc_name
	---> rl_proc_name(
		string,			% user
		string,			% module
		string,			% name
		int			% arity
	).

%-----------------------------------------------------------------------------%

:- type relation_id == int.

:- type relation_info_map == map(relation_id, relation_info).

:- type relation_info
	---> relation_info(
		relation_type,
		list(type),		% schema
		list(index_spec),
			% Only used for base relations - other relations
			% may have different indexes at different times.
		string			% name
	).

:- type relation_type
	--->	permanent(pred_proc_id)
	;	temporary(relation_state).

	% It may be possible that we only want to materialise a relation
	% along certain branches. That should be fairly simple to fix later
	% if it is necessary.
:- type relation_state
	--->	materialised
	;	stream.

%-----------------------------------------------------------------------------%

	% A key range gives an upper and lower bound for the part of the
	% indexed relation to search. For example, a simple B-tree join
	% algorithm takes a tuple from first relation and uses it to build
	% a key-range for the (indexed) second relation. The join condition
	% is then applied to the tuple from the first relation and every tuple
	% in the second which falls within the key range.
:- type key_range
	---> key_range(
		bounding_tuple,		% lower bound
		bounding_tuple,		% upper bound
		maybe(list(type)),	% schema of the tuple used to generate
					% the key range - there isn't one
					% for selects.
		list(type)		% schema of the tuple used to search
					% the B-tree index
	).

:- type bounding_tuple
	--->	infinity		% -infinity for lower bound,
					% +infinity for upper bound
	;	bound(
			assoc_list(int, key_attr)
					% attributes of the key tuple, the
					% associated integer is the index
					% in a full tuple for that index
					% attribute.
		)
	.

:- type key_attr
	--->	functor(cons_id, (type), list(key_attr))
	;	infinity		% -infinity for lower bound,
					% +infinity for upper
					% This is currently not supported,
					% since there may not be a way to
					% construct a term representing
					% infinity.
	;	input_field(int)
	.

%-----------------------------------------------------------------------------%

		% instruction and a comment. 
:- type rl_instruction	==	pair(rl_instr, string).

:- type rl_instr
	--->
		join(
			output_rel,		% output
			relation_id,		% input 1
			relation_id,		% input 2
			join_type,
			rl_goal,		% join condition
			maybe(semi_join_info),
			maybe(trivial_join_info)
		)
	;
		subtract(	% output = input 1 - input 2
			output_rel,		% output
			relation_id,		% input 1
			relation_id,		% input 2
			subtract_type,
			rl_goal,		% subtraction condition
			maybe(trivial_subtract_info)
		)
	;
		% A difference is just a special case of subtract.
		% The inputs must be sorted and have the same schema.	
		difference(	% output = input 1 - input 2
			output_rel,		% output
			relation_id,		% input 1
			relation_id,		% input 2
			difference_type
		)
	;
		% A projection may have any number of output relations to
		% avoid multiple traversals over the input relation.
		% This also does selection - the expressions are allowed to
		% fail.
		% All but one of the outputs must be materialised - at the
		% moment we materialise them all because it is difficult
		% to ensure correctness for streams with side-effects.
		project(
			output_rel,		% output (may be a stream)
			relation_id,		% input
			rl_goal,		% projection expression for
						% stream output
			assoc_list(output_rel, rl_goal),
						% other outputs (materialised)
			project_type
		)		
	;
		union(
			output_rel,		% output
			list(relation_id),	% inputs
			union_type
		)
	;
		% Output = Input1 U Input2, Difference = Input1 - Input2
		% Input1 must have a B-tree index, and is destructively
		% updated to create Output.
		union_diff(
			relation_id,	% output (uo) (same indexes as input 1)
			relation_id,	% input 1 (di)
			relation_id, 	% input 2 (in)
			output_rel,	% difference (out)
			index_spec,
			maybe(output_rel)
				% Used by rl_liveness.m to make sure that
				% the di input has a single reference. The
				% relation_id is used to hold a copy of the
				% di relation if required. The indexes should
				% be added to the copy if it is made.
		)	
	;
		% Insert a relation into another relation.
		% The input relation is destructively updated.
		insert(
			relation_id,	% output (uo) (same indexes as di input)
			relation_id,	% relation to be inserted into (di)
			relation_id,	% relation to insert (in)
			insert_type,
			maybe(output_rel)
				% Used by rl_liveness.m to make sure that
				% the di input has a single reference. The
				% relation_id is used to hold a copy of the
				% di relation if required. The indexes should
				% be added to the copy if it is made.
		)
	;
		sort(
			output_rel,		% output
			relation_id,		% input
			sort_attrs		% attributes to sort on
		)
	;
		% Make the output variable refer to the same relation
		% as the input without copying.
		ref(
			relation_id,		% output
			relation_id 		% input
		)
	;
		% Make a copy of the input relation, making sure the
		% output has the given set of indexes.
		% This could be a bit slow, because the system can't just
		% copy the files, but has to do a full tuple-by-tuple copy.
		copy(
			output_rel,		% output
			relation_id		% input
		)
	;
		% If there are multiple references to the input, copy the
		% input to the output, otherwise make the output a reference
		% to the input. To introduce this, the compiler must know that
		% there are no later references in the code to the input
		% relation. Base relations and named temporaries are always
		% copied, because they have an implicit reference in the
		% database's `relation name -> relation contents' mapping. 
		%
		% Make sure the output has the given set of indexes, even
		% if it isn't copied.
		make_unique(
			output_rel,		% output
			relation_id		% input
		)
	;
		% Create an empty relation.
		init(output_rel)
	;
		% add a tuple to a relation.
		insert_tuple(	
			output_rel,		% output
			relation_id,		% input
			rl_goal
		)
	;
		% call an RL procedure
		call(
			rl_proc_name,		% called procedure
			list(relation_id),	% input argument relations
			list(output_rel),	% output argument relations
			set(relation_id)	% subset of the inputs which
						% must be saved across the call,
						% filled in by rl_liveness.m.
		)
	;
		aggregate(
			output_rel,		% output relation
			relation_id,		% input relation
			pred_proc_id,		% predicate to produce the
						% initial accumulator for
						% each group
			pred_proc_id		% predicate to update the
						% accumulator for each tuple.
		)	
	;
		% Assign the input relation to the output, ensuring
		% that the output has the appropriate indexes.
		% If the input relation is a base relation, this will
		% copy the input to the output. This sounds expensive,
		% but currently in all cases where an index is added
		% to something that might be a base relation, a copy
		% needs to be made anyway because the relation is
		% destructively updated by a uniondiff operation --
		% all that will happen is that the make_unique instruction
		% later will not need to make a copy.
		%
		% We don't include a remove_index operation because it
		% would be very expensive and probably not very useful.
		add_index(output_rel, relation_id)
	;
		% Empty a relation. This will be expensive for permanent
		% relations due to logging.
		clear(relation_id)
	;
		% Drop a pointer to a temporary relation. The relation
		% is left unchanged, but may be garbage collected if
		% there are no references to it.
		unset(relation_id)
	;
		label(label_id)
	;
		conditional_goto(goto_cond, label_id)
	;
		goto(label_id)
	;
		comment
	.

	% An output relation first clears the initial contents of the
	% relation, then initialises the relation with the given set
	% of indexes.
:- type output_rel
	---> output_rel(
		relation_id,
		list(index_spec)
	).

:- type goto_cond
	--->	empty(relation_id)
	;	and(goto_cond, goto_cond)
	;	or(goto_cond, goto_cond)
	;	not(goto_cond).

:- type join_type
	--->	nested_loop
	;	sort_merge(sort_spec, sort_spec)
	;	hash(list(int), list(int))
				% Hash join, used for joins where
				% the condition tests equality of
				% one or more attributes of the input
				% relations.
				% Attribute numbers start at 1.
	;	index(index_spec, key_range)
				% The second relation is indexed.
				% Each tuple in the first relation
				% is used to create a key range
				% for accessing the second. The goal
				% builds the lower and upper bounds
				% on the key range from the input
				% tuple from the first relation.
	.


	% A semi-join does not do a projection on the output - it
	% just returns one of the input tuples.
:- type semi_join_info == tuple_num.

	% For some joins the join condition does not depend on
	% one of the input tuples. This commonly happens for joins
	% with a zero-arity input relation at the start of a procedure.
	%
	% Output = join(Input1, Input2, Cond), where Cond does
	% not depend on Input2, can be generated as:
	%
	%	if (empty(Input2)) {
	%		Output = project(Input1, Cond)
	%	} else {
	%		init(Output)
	%	}
	%
	% If the join is a semi-join with a deterministic
	% condition, the project is not necessary.
	%
	% Subtracts are similar.
	%
	%	Output = semi_subtract(Input1, Input2, Cond).
	%
	% If Cond does not depend on Input1, this can be generated
	% as:
	%
	%	if (empty(select(Input2, Cond))) {
	%		Output = Input1
	%	} else {
	%		init(Output)
	%	}
	%
	% If Cond does not depend on Input2, this can be generated
	% as:
	%
	%	if (empty(Input2)) {
	%		Output = Input1
	%	} else {
	%		Output = select(Input1, not(Cond))
	%	}
	%
	%
	% We don't just do this optimization in the intermediate RL
	% because it introduces extra branching which can interfere
	% with other optimizations (e.g. rl_block_opt.m, rl_stream.m).
:- type trivial_join_or_subtract_info
	---> trivial_join_or_subtract_info(
		tuple_num,	% which tuple does the join depend on
		maybe(project_type)
				% the type of selection/projection to use,
				% if one is needed
	).

:- type trivial_join_info == trivial_join_or_subtract_info.
:- type trivial_subtract_info == trivial_join_or_subtract_info.

	% All subtracts are done using the semi-subtract operator.
	% There is no advantage in including any post projection
	% in the operation because the projection cannot use any
	% of the intermediate results of the test -- the projection
	% is only done if the test fails for all negated tuples.
:- type subtract_type
	--->	semi_nested_loop
	;	semi_sort_merge(sort_spec, sort_spec)
				% Hash join, used for joins where
				% the condition tests equality of
				% one or more attributes of the input
				% relations.
				% Attribute numbers start at 1.
	;	semi_hash(list(int), list(int))
	;	semi_index(index_spec, key_range)
				% The negated (second) input relation
				% is indexed.
	.

:- type difference_type
	--->	sort_merge(sort_spec)
	.
		
:- type project_type
	--->	filter
	;	index(index_spec, key_range)
	.

:- type union_type
	--->	sort_merge(sort_spec)
	.

:- type insert_type
	--->	append
	;	index(index_spec).

%-----------------------------------------------------------------------------%

:- type sort_spec
	--->	sort_var(int)		% Some operations, such as union,
					% expect their inputs to be sorted
					% on all attributes, but don't care
					% in which order or direction.
	;	attributes(sort_attrs)
					% Sort on the given attributes.
	.

	% Attribute numbers start at 1.
:- type sort_attrs == assoc_list(int, sort_dir).

:- type sort_dir
	--->	ascending
	;	descending
	.

%-----------------------------------------------------------------------------%

	% We delay converting join conditions to the lower level representation
	% for as long as possible because they are easier to deal with in
	% hlds_goal form.
:- type rl_goal
	---> rl_goal(
		pred_proc_id :: maybe(pred_proc_id),	
				% Predicate from which the expression was
				% taken - used to avoid unnecessarily merging 
				% varsets. Should be `no' if the varset
				% contains vars from multiple procs.
		varset :: prog_varset,
		vartypes :: map(prog_var, type),
		instmap:: instmap,	% instmap before goal
		inputs :: rl_goal_inputs,
		outputs :: rl_goal_outputs,
		goal :: list(hlds_goal),
		bounds :: list(rl_var_bounds)
	).

:- type rl_goal_inputs
	--->	no_inputs
	;	one_input(list(prog_var))
	;	two_inputs(list(prog_var), list(prog_var))
	.

:- type rl_goal_outputs == maybe(list(prog_var)).

	% A key_term is an intermediate form of a key_attr which keeps
	% aliasing information. This can be converted into a key_range
	% later. The set of variables attached to each node is the
	% set of all variables in the goal which were found by rl_key.m
	% to have that value.
:- type key_term == pair(key_term_node, set(prog_var)).
:- type key_term_node
        --->    functor(cons_id, (type), list(key_term))
        ;       var
        .

:- type rl_var_bounds == map(prog_var, pair(key_term)).

:- type tuple_num
	--->	one
	;	two
	.

%-----------------------------------------------------------------------------%

:- type label_id == int.

%-----------------------------------------------------------------------------%

:- pred rl__default_temporary_state(module_info::in,
		relation_state::out) is det.

	% rl__instr_relations(Instr, InputRels, OutputRels).
:- pred rl__instr_relations(rl_instruction::in, 
		list(relation_id)::out, list(relation_id)::out) is det.

	% Return all relations referenced by a goto condition.
:- pred rl__goto_cond_relations(goto_cond::in, 
		list(relation_id)::out) is det.

	% Is the instructions a label, goto or conditional goto.
:- pred rl__instr_ends_block(rl_instruction).
:- mode rl__instr_ends_block(in) is semidet.

	% Strip off the index specification from an output relation.
:- pred rl__output_rel_relation(output_rel::in, relation_id::out) is det.

	% Get a sort specification sorting ascending on all attributes.	
:- pred rl__ascending_sort_spec(list(type)::in, sort_attrs::out) is det.

	% Get a list of all attributes for a given schema.
:- pred rl__attr_list(list(T)::in, list(int)::out) is det.

:- pred rl__is_semi_join(join_type::in, rl_goal::in,
		maybe(semi_join_info)::out) is det.

	% See the comment on type trivial_join_or_subtract_info.
:- pred rl__is_trivial_join(module_info::in, join_type::in,
	rl_goal::in, maybe(semi_join_info)::in,
	maybe(trivial_join_info)::out) is det.

	% See the comment on type trivial_join_or_subtract_info.
:- pred rl__is_trivial_subtract(module_info::in, subtract_type::in,
	rl_goal::in, maybe(trivial_subtract_info)::out) is det.

	% Find the project type which is equivalent to the join type,
	% useful for a trivial join which can be converted into a projection.
:- pred rl__join_type_to_project_type(join_type::in,
		maybe(project_type)::out) is det.

	% Find the project type which is equivalent to the subtract type.
	% useful for a trivial subtract which can be converted into a
	% projection.
:- pred rl__subtract_type_to_project_type(subtract_type::in,
		maybe(project_type)::out) is det.

	% Succeed if the goal contain any of the variables corresponding
	% to the attributes of the given input tuple.
:- pred rl__goal_is_independent_of_input(tuple_num::in,
		rl_goal::in) is semidet.

	% Remove the specified input tuple from the goal, aborting
	% if the goal is not independent of that input tuple.
:- pred rl__remove_goal_input(tuple_num::in, rl_goal::in, rl_goal::out) is det.

:- pred rl__swap_join_type_inputs(join_type::in, join_type::out) is det.

	% Swap the inputs of a goal such as a join condition which
	% has two input relations.
:- pred rl__swap_goal_inputs(rl_goal::in, rl_goal::out) is det.
	
	% Remove the output tuple from a goal, converting a join
	% into a semi-join. 
:- pred rl__strip_goal_outputs(rl_goal::in, rl_goal::out) is det.

	% Succeed if the goal produces an output tuple.
:- pred rl__goal_produces_tuple(rl_goal::in) is semidet.

	% Succeed if a project/select with the given condition
	% can be removed without changing the semantics of the
	% program.
:- pred rl__goal_can_be_removed(module_info::in,
		list(hlds_goal)::in) is semidet.

	% If the goal has an output tuple, check whether the
	% output tuple is the same as one of the input tuples.
	% If the operator is a join, the semi-join operator can be used.
:- pred rl__goal_returns_input_tuple(rl_goal::in, tuple_num::out) is semidet.

:- pred rl__swap_tuple_num(tuple_num::in, tuple_num::out) is det.

%-----------------------------------------------------------------------------%

	% Find out the name of the RL procedure corresponding
	% to the given Mercury procedure.
:- pred rl__get_entry_proc_name(module_info::in, pred_proc_id::in,
		rl_proc_name::out) is det.

	% rl__get_insert_proc_name(ModuleInfo, BaseRelationPredId, ProcName).
	%
	% Get the name of the RL procedure used to apply a bulk insertion
	% to a base relation.
:- pred rl__get_insert_proc_name(module_info::in,
		pred_id::in, rl_proc_name::out) is det.

	% rl__get_delete_proc_name(ModuleInfo, BaseRelationPredId, ProcName).
	%
	% Get the name of the RL procedure used to apply a deletion
	% to a base relation.
:- pred rl__get_delete_proc_name(module_info::in,
		pred_id::in, rl_proc_name::out) is det.

	% rl__get_modify_proc_name(ModuleInfo, BaseRelationPredId, ProcName).
	%
	% Get the name of the RL procedure used to apply a modification
	% to a base relation.
:- pred rl__get_modify_proc_name(module_info::in,
		pred_id::in, rl_proc_name::out) is det.

	% rl__get_c_interface_proc_name(ModuleInfo, PredProcId, ProcName).
	%
	% Get the name of the RL procedure used to call an Aditi
	% procedure from ordinary Mercury code.
:- pred rl__get_c_interface_proc_name(module_info::in, pred_proc_id::in,
		string::out) is det.

:- pred rl__get_c_interface_rl_proc_name(module_info::in, pred_proc_id::in,
		rl_proc_name::out) is det.

	% Work out the name for a permanent relation.
:- pred rl__permanent_relation_name(module_info::in,
		pred_id::in, string::out) is det.

	% rl__get_permanent_relation_info(ModuleInfo, PredId,
	% 	Owner, Module, Name, Arity, RelationName, SchemaString).
:- pred rl__get_permanent_relation_info(module_info::in, pred_id::in,
		string::out, string::out, string::out, int::out,
		string::out, string::out) is det.

%-----------------------------------------------------------------------------%

:- pred rl__proc_name_to_string(rl_proc_name::in, string::out) is det.
:- pred rl__label_id_to_string(label_id::in, string::out) is det.
:- 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 code_util, code_aux, globals, llds_out, options, prog_out.
:- import_module mode_util, prog_util, type_util, llds.
:- import_module bool, int, require, string.

rl__default_temporary_state(ModuleInfo, TmpState) :-
	module_info_globals(ModuleInfo, Globals),
	globals__lookup_bool_option(Globals, detect_rl_streams, Streams),
	(
		Streams = yes,
		TmpState = stream
	;
		Streams = no,
		% We have to assume that everything must be materialised.
		TmpState = materialised
	).

%-----------------------------------------------------------------------------%

rl__instr_relations(
		join(output_rel(Output, _), Input1, Input2, _, _, _, _) - _, 
		[Input1, Input2], [Output]).
rl__instr_relations(subtract(output_rel(Output, _),
		Input1, Input2, _, _, _) - _, [Input1, Input2], [Output]).
rl__instr_relations(difference(output_rel(Output, _),
		Input1, Input2, _) - _, [Input1, Input2], [Output]).
rl__instr_relations(project(OutputRel,
		Input, _, OtherOutputRels, _) - _,
		[Input], Outputs) :-
	assoc_list__keys(OtherOutputRels, OutputRels),
	list__map(rl__output_rel_relation, 
		 [OutputRel | OutputRels], Outputs).
rl__instr_relations(union(OutputRel, Inputs, _) - _, Inputs, [Output]) :-
	rl__output_rel_relation(OutputRel, Output).
rl__instr_relations(union_diff(UoOutput, DiInput, Input,
		output_rel(Diff, _), _, _) - _, 
		[DiInput, Input], [UoOutput, Diff]).
rl__instr_relations(insert(DiOutput, DiInput, Input, _, _) - _,
		[DiInput, Input], [DiOutput]).
rl__instr_relations(sort(output_rel(Output, _), Input, _) - _,
		[Input], [Output]).
rl__instr_relations(init(output_rel(Rel, _)) - _, [], [Rel]).
rl__instr_relations(insert_tuple(output_rel(Output, _), Input, _) - _,
		[Input], [Output]).
rl__instr_relations(add_index(output_rel(Output, _), Input) - _,
		[Input], [Output]).
rl__instr_relations(clear(Rel) - _, [], [Rel]).
rl__instr_relations(unset(Rel) - _, [], [Rel]).
rl__instr_relations(label(_) - _, [], []).
rl__instr_relations(goto(_) - _, [], []).
rl__instr_relations(comment - _, [], []).
rl__instr_relations(conditional_goto(Cond, _) - _, Inputs, []) :-
	rl__goto_cond_relations(Cond, Inputs).
rl__instr_relations(ref(Output, Input) - _, [Input], [Output]).
rl__instr_relations(copy(output_rel(Output, _), Input) - _,
		[Input], [Output]).
rl__instr_relations(make_unique(output_rel(Output, _), Input) - _,
		[Input], [Output]).
rl__instr_relations(aggregate(output_rel(Output, _), Input, _, _) - _,
		[Input], [Output]).
rl__instr_relations(call(_, Inputs, OutputRels, _) - _,
		Inputs, Outputs) :-
	list__map(rl__output_rel_relation, OutputRels, Outputs).

%-----------------------------------------------------------------------------%

rl__instr_ends_block(goto(_) - _).
rl__instr_ends_block(label(_) - _).
rl__instr_ends_block(conditional_goto(_, _) - _).

%-----------------------------------------------------------------------------%

rl__output_rel_relation(output_rel(Output, _), Output).

%-----------------------------------------------------------------------------%

rl__goto_cond_relations(empty(Rel), [Rel]).
rl__goto_cond_relations(and(Cond1, Cond2), Rels) :-
	rl__goto_cond_relations(Cond1, Rels1),
	rl__goto_cond_relations(Cond2, Rels2),
	list__append(Rels1, Rels2, Rels).
rl__goto_cond_relations(or(Cond1, Cond2), Rels) :-
	rl__goto_cond_relations(Cond1, Rels1),
	rl__goto_cond_relations(Cond2, Rels2),
	list__append(Rels1, Rels2, Rels).
rl__goto_cond_relations(not(Cond), Rels) :-
	rl__goto_cond_relations(Cond, Rels).

%-----------------------------------------------------------------------------%

rl__ascending_sort_spec(Schema, Attrs) :-
	GetAttr =
		lambda([_::in, Attr::out, Index0::in, Index::out] is det, (
			Attr = Index0 - ascending,
			Index is Index0 + 1
		)),
	list__map_foldl(GetAttr, Schema, Attrs, 1, _).

rl__attr_list(Schema, Attrs) :-
	rl__attr_list_2(1, Schema, Attrs).

:- pred rl__attr_list_2(int::in, list(T)::in,
		list(int)::out) is det.

rl__attr_list_2(_, [], []).
rl__attr_list_2(Index, [_ | Types], [Index | Attrs]) :-
	NextIndex is Index + 1,
	rl__attr_list_2(NextIndex, Types, Attrs).

%-----------------------------------------------------------------------------%

rl__is_semi_join(JoinType, Exprn, SemiJoinInfo) :-
	(
		rl__goal_returns_input_tuple(Exprn, SemiTupleNum),

		% XXX sort-merge semi-joins are
		% not yet implemented in Aditi.
		JoinType \= sort_merge(_, _),

		%
		% An indexed semi-join where the tuple from the
		% indexed relation is returned is not
		% strictly a semi-join. A semi-join is normally
		% guaranteed to return each tuple only once, but
		% the indexed tuples may match against multiple
		% tuples in the non-indexed relation.
		%
		( JoinType = index(_, _) => SemiTupleNum = one )
	->
		SemiJoinInfo = yes(SemiTupleNum)
	;
		SemiJoinInfo = no
	).

rl__is_trivial_join(ModuleInfo, JoinType, Cond,
		SemiJoinInfo, TrivialJoinInfo) :-
	(
		rl__join_type_to_project_type(JoinType, yes(ProjectType))
	->
		rl__is_trivial_join_or_subtract(ModuleInfo, join,
			ProjectType, Cond, SemiJoinInfo, TrivialJoinInfo)
	;
		TrivialJoinInfo = no
	).

rl__is_trivial_subtract(ModuleInfo, SubtractType, Cond, TrivialSubtractInfo) :-
	(
		rl__subtract_type_to_project_type(SubtractType,
			yes(ProjectType))
	->
		% Subtracts always return the first input tuple.
		SemiJoinInfo = yes(one),
		rl__is_trivial_join_or_subtract(ModuleInfo, subtract,
			ProjectType, Cond, SemiJoinInfo, TrivialSubtractInfo)
	;
		TrivialSubtractInfo = no
	).

:- type join_or_subtract
	--->	join
	;	subtract
	.

:- pred rl__is_trivial_join_or_subtract(module_info::in, join_or_subtract::in,
		project_type::in, rl_goal::in, maybe(semi_join_info)::in,
		maybe(trivial_join_or_subtract_info)::out) is det.

rl__is_trivial_join_or_subtract(ModuleInfo, JoinOrSubtract, ProjectType, Cond,
		SemiJoinInfo, TrivialJoinInfo) :-
	( rl__goal_is_independent_of_input(one, Cond) ->
		rl__make_trivial_join_or_subtract_info(ModuleInfo,
			JoinOrSubtract, ProjectType, Cond, two, SemiJoinInfo,
			TrivialJoinInfo)
	; rl__goal_is_independent_of_input(two, Cond) ->
		rl__make_trivial_join_or_subtract_info(ModuleInfo,
			JoinOrSubtract, ProjectType, Cond, one,
			SemiJoinInfo, TrivialJoinInfo)
	;
		TrivialJoinInfo = no
	).

:- pred rl__make_trivial_join_or_subtract_info(module_info::in,
		join_or_subtract::in, project_type::in, rl_goal::in,
		tuple_num::in, maybe(semi_join_info)::in,
		maybe(trivial_join_or_subtract_info)::out) is det.

rl__make_trivial_join_or_subtract_info(ModuleInfo, JoinOrSubtract, ProjectType,
		Cond, UsedTupleNum, SemiJoin, TrivialJoinInfo) :-
	Goals = Cond ^ goal,

	(
		%
		% A projection is not needed for semi-joins with
		% deterministic conditions.
		% 
		SemiJoin = yes(_),
		\+ ( 
			% For this type of trivial subtract,
			% the selection will use the negation
			% of the condition, which will pretty
			% much always be semidet.
			% The select can only be removed if the
			% condition has determinism failure, in
			% which case the negation should have been
			% removed earlier.
			JoinOrSubtract = subtract,
			UsedTupleNum = one
		),
		rl__goal_can_be_removed(ModuleInfo, Goals)
	->
		MaybeProjectType = no
	;
		MaybeProjectType = yes(ProjectType)
	),

	TrivialJoinInfo =
		yes(trivial_join_or_subtract_info(UsedTupleNum,
			MaybeProjectType)).

	% Check whether a projection is needed.
	% A projection is not needed if it is a selection
	% (there is no output tuple) and the selection condition
	% is deterministic.
:- pred rl__is_removeable_project(module_info::in, project_type::in,
		rl_goal::in, bool::out) is det.

rl__is_removeable_project(ModuleInfo, ProjectType, RLGoal, IsRemoveable) :-
	(
		ProjectType = filter,
		(
			\+ rl__goal_produces_tuple(RLGoal),
			Goals = RLGoal ^ goal,

			rl__goal_can_be_removed(ModuleInfo, Goals)
        	->
			IsRemoveable = yes
		;
			IsRemoveable = no
		)
	;
		%
		% Indexed projections contain a selection
		% which must always be performed.
		%
		ProjectType = index(_, _),
		IsRemoveable = no
	).

rl__goal_can_be_removed(ModuleInfo, Goals) :-
	goal_list_determinism(Goals, Detism),
	determinism_components(Detism, cannot_fail, MaxSoln),
	MaxSoln \= at_most_zero,

	module_info_globals(ModuleInfo, Globals),
	globals__lookup_bool_option(Globals, fully_strict, FullyStrict),

	% I'm not sure whether this test is actually worthwhile --
	% the optimization passes which introduce index, sort-merge
	% and hash joins and subtracts prune away large chunks of
	% computation without caring about the semantics.
	(
		FullyStrict = no
	;
		all [Goal] (	
			list__member(Goal, Goals)
		=>
			code_aux__goal_cannot_loop(ModuleInfo, Goal)
		)
	).

rl__join_type_to_project_type(nested_loop, yes(filter)).
rl__join_type_to_project_type(index(IndexSpec, KeyRange0),
		yes(index(IndexSpec, KeyRange))) :-
	join_key_range_to_project_key_range(KeyRange0, KeyRange).
	
	%
	% Introducing sort-merge and hash joins means that there is a
	% connection between the arguments of the two input tuples, so
	% the join cannot be turned into a projection.
	%
join_type_to_project_type(sort_merge(_, _), no).
join_type_to_project_type(hash(_, _), no).


subtract_type_to_project_type(semi_nested_loop, yes(filter)).
subtract_type_to_project_type(semi_index(IndexSpec, KeyRange0),
		yes(index(IndexSpec, KeyRange))) :-
	join_key_range_to_project_key_range(KeyRange0, KeyRange).

	%
	% Introducing sort-merge and hash subtracts means that there is a
	% connection between the arguments of the two input tuples, so
	% the subtract cannot be turned into a projection.
	%
subtract_type_to_project_type(semi_sort_merge(_, _), no).
subtract_type_to_project_type(semi_hash(_, _), no).

	% The expression to create a key range for a project/select does
	% not take an input tuple.
:- pred join_key_range_to_project_key_range(key_range::in,
		key_range::out) is det.

join_key_range_to_project_key_range(key_range(A, B, _, D),
	key_range(A, B, no, D)).

rl__remove_goal_input(InputNo, RLGoal0, RLGoal) :-
	require(rl__goal_is_independent_of_input(InputNo, RLGoal0),
		"rl__remove_goal_input: not independent"),
	rl__select_input_args(InputNo, RLGoal0 ^ inputs, Inputs, _),
	RLGoal = RLGoal0 ^ inputs := Inputs.

rl__goal_is_independent_of_input(InputNo, RLGoal) :-
	rl__select_input_args(InputNo, RLGoal ^ inputs, _, InputArgs),
	MaybeOutputs = RLGoal ^ outputs,
	Goals = RLGoal ^ goal,
	set__list_to_set(InputArgs, InputArgSet),
	\+ (
		MaybeOutputs = yes(Outputs),
		set__list_to_set(Outputs, OutputSet),
		set__intersect(OutputSet, InputArgSet, OutputIntersection),
		\+ set__empty(OutputIntersection)  
	),
	\+ (
		list__member(Goal, Goals),
		Goal = _ - GoalInfo,
		goal_info_get_nonlocals(GoalInfo, NonLocals),
		set__intersect(NonLocals, InputArgSet, Intersection),
		\+ set__empty(Intersection)  
	).

:- pred rl__select_input_args(tuple_num::in, rl_goal_inputs::in,
		rl_goal_inputs::out, list(prog_var)::out) is det.

rl__select_input_args(_, no_inputs, _, _) :-
	error("rl__select_input_args").
rl__select_input_args(one, one_input(Args), no_inputs, Args).
rl__select_input_args(two, one_input(_), _, _) :-
	error("rl__select_input_args").
rl__select_input_args(one, two_inputs(Args, Args2),
		one_input(Args2), Args).
rl__select_input_args(two, two_inputs(Args1, Args),
		one_input(Args1), Args).

rl__swap_join_type_inputs(nested_loop, nested_loop).
rl__swap_join_type_inputs(sort_merge(A, B), sort_merge(B, A)).
rl__swap_join_type_inputs(hash(A, B), hash(B, A)).
rl__swap_join_type_inputs(index(_, _), _) :-
	error("rl__swap_join_type_inputs: can't swap inputs of index join"). 

rl__swap_goal_inputs(RLGoal0, RLGoal) :-
	Inputs0 = RLGoal0 ^ inputs,
	( Inputs0 = two_inputs(Inputs1, Inputs2) ->
		RLGoal = RLGoal0 ^ inputs := two_inputs(Inputs2, Inputs1)
	;
		error("rl__swap_inputs: goal does not have two inputs to swap")
	).

rl__strip_goal_outputs(RLGoal0, RLGoal0 ^ outputs := no).

rl__goal_produces_tuple(RLGoal) :-
	RLGoal ^ outputs = yes(_).

rl__goal_returns_input_tuple(RLGoal, TupleReturned) :-
	Inputs = RLGoal ^ inputs,
	yes(OutputVars) = RLGoal ^ outputs,
	(
		Inputs = two_inputs(InputVars1, InputVars2),
		( InputVars1 = OutputVars ->
			TupleReturned = one
		; InputVars2 = OutputVars ->
			TupleReturned  = two
		;
			fail
		)
	;
		Inputs = one_input(OutputVars),
		TupleReturned = one
	).

rl__swap_tuple_num(one, two).
rl__swap_tuple_num(two, one).

%-----------------------------------------------------------------------------%

rl__get_entry_proc_name(ModuleInfo, PredProcId, ProcName) :-
	PredProcId = proc(PredId, _),
	module_info_pred_info(ModuleInfo, PredId, PredInfo),
	pred_info_name(PredInfo, PredName),
	pred_info_arity(PredInfo, Arity),
	rl__get_entry_proc_name(ModuleInfo, PredProcId,
		PredInfo, PredName, Arity, ProcName).

:- pred rl__get_entry_proc_name(module_info::in, pred_proc_id::in,
	pred_info::in, string::in, arity::in, rl_proc_name::out) is det.

rl__get_entry_proc_name(ModuleInfo, PredProcId, PredInfo, PredName, Arity,
		ProcName) :-
	PredProcId = proc(_, ProcId),
	module_info_name(ModuleInfo, ModuleName),
	pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
	pred_info_module(PredInfo, PredModule),
	pred_info_get_aditi_owner(PredInfo, Owner),
	IsImported = (pred_info_is_imported(PredInfo) -> yes ; no),
	code_util__make_user_proc_label(ModuleName, IsImported,
		PredOrFunc, PredModule, PredName, Arity, ProcId, ProcLabel),
	llds_out__get_proc_label(ProcLabel, no, ProcLabelStr),
	prog_out__sym_name_to_string(PredModule, PredModuleStr),
	ProcName = rl_proc_name(Owner, PredModuleStr, ProcLabelStr, 2).

rl__get_insert_proc_name(ModuleInfo, PredId, ProcName) :-
	rl__get_update_proc_name(ModuleInfo, PredId,
		"Aditi_Insert_Proc_For_", ProcName).

rl__get_delete_proc_name(ModuleInfo, PredId, ProcName) :-
	rl__get_update_proc_name(ModuleInfo, PredId,
		"Aditi_Delete_Proc_For_", ProcName).

rl__get_modify_proc_name(ModuleInfo, PredId, ProcName) :-
	rl__get_update_proc_name(ModuleInfo, PredId,
		"Aditi_Modify_Proc_For_", ProcName).

:- pred rl__get_update_proc_name(module_info::in,
		pred_id::in, string::in, rl_proc_name::out) is det.

rl__get_update_proc_name(ModuleInfo, PredId, ProcNamePrefix, ProcName) :-
	hlds_pred__initial_proc_id(ProcId),
	rl__get_entry_proc_name(ModuleInfo, proc(PredId, ProcId), ProcName0),
	ProcName0 = rl_proc_name(Owner, Module, Name0, Arity),
	string__append(ProcNamePrefix, Name0, Name),
	ProcName = rl_proc_name(Owner, Module, Name, Arity).

rl__get_c_interface_proc_name(ModuleInfo, PredProcId, PredName) :-
	PredProcId = proc(PredId, ProcId),
	module_info_pred_info(ModuleInfo, PredId, PredInfo),
	pred_info_name(PredInfo, PredName0),
	proc_id_to_int(ProcId, ProcInt),
	string__int_to_string(ProcInt, ProcStr),
	pred_info_arg_types(PredInfo, ArgTypes),
	list__length(ArgTypes, Arity),
	string__int_to_string(Arity, ArityStr),
	string__append_list(["Aditi_C_Interface_Proc_For_Mode_", ProcStr,
		"_Of_", PredName0, "_", ArityStr], PredName).

rl__get_c_interface_rl_proc_name(ModuleInfo, PredProcId, ProcName) :-
	rl__get_c_interface_proc_name(ModuleInfo, PredProcId, PredName),
	module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
	pred_info_arg_types(PredInfo, ArgTypes0),
	proc_info_argmodes(ProcInfo, ArgModes0),
	type_util__remove_aditi_state(ArgTypes0, ArgModes0, ArgModes),
	partition_args(ModuleInfo, ArgModes, ArgModes, _, OutputArgModes),

	% The interface procedure includes only the output arguments
	% from the original procedure and the input closure argument
	% introduced by magic.m.
	list__length(OutputArgModes, NumOutputArgs),
	InterfaceArity = NumOutputArgs + 1,
	rl__get_entry_proc_name(ModuleInfo, PredProcId, PredInfo,
		PredName, InterfaceArity, ProcName).
			
rl__permanent_relation_name(ModuleInfo, PredId, ProcName) :-
	rl__get_permanent_relation_info(ModuleInfo, PredId, Owner,
		Module, _, _, Name, _),
	string__format("%s/%s/%s", [s(Owner), s(Module), s(Name)],
		ProcName).

rl__get_permanent_relation_info(ModuleInfo, PredId, Owner, PredModule,
		PredName, PredArity, RelName, SchemaString) :-
	module_info_pred_info(ModuleInfo, PredId, PredInfo),
	pred_info_name(PredInfo, PredName),
	pred_info_module(PredInfo, PredModule0),
	prog_out__sym_name_to_string(PredModule0, PredModule),
	pred_info_get_aditi_owner(PredInfo, Owner),
	pred_info_arity(PredInfo, PredArity),
	string__format("%s__%i", [s(PredName), i(PredArity)], RelName),
	pred_info_arg_types(PredInfo, ArgTypes0),
	type_util__remove_aditi_state(ArgTypes0, ArgTypes0, ArgTypes),
	rl__schema_to_string(ModuleInfo, ArgTypes, SchemaString).

%-----------------------------------------------------------------------------%

rl__proc_name_to_string(rl_proc_name(User, Module, Pred, Arity), Str) :-
	string__int_to_string(Arity, ArStr),
	string__append_list([User, "/", Module, "/", Pred, "/", ArStr], Str).

rl__label_id_to_string(Label, Str) :-
	string__int_to_string(Label, Str0),
	string__append("label", Str0, Str).

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 = tuple_type,
		rl__gather_du_type(ModuleInfo, Parents, Type, GatheredTypes0,
			GatheredTypes, RecursiveTypes0, RecursiveTypes,
			Decls0, Decls, ThisType)
	;
		ClassifiedType = pred_type,
		error("rl__gather_type: pred type")
	;
		ClassifiedType = user_type,
		% We can't handle abstract types here. magic_util.m
		% checks that there are none.
		rl__gather_du_type(ModuleInfo, Parents, Type, GatheredTypes0,
			GatheredTypes, RecursiveTypes0, RecursiveTypes,
			Decls0, Decls, ThisType)
	).

:- pred rl__gather_du_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_du_type(ModuleInfo, Parents, Type, GatheredTypes0, GatheredTypes,
		RecursiveTypes0, RecursiveTypes, Decls0, Decls, ThisType) :-
	(
		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),

	assoc_list__values(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)
	).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%