mercury/compiler/ml_string_switch.m

%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2004 The 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: ml_string_switch.m
% author: fjh (adapted from string_switch.m)

% For switches on strings, we generate a hash table using open addressing
% to resolve hash conflicts.

% WARNING: the code here is quite similar to the code in string_switch.m.
% Any changes here may require similar changes there and vice versa.

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

:- module ml_backend__ml_string_switch.

:- interface.

:- import_module backend_libs__switch_util.
:- import_module hlds__code_model.
:- import_module hlds__hlds_data.
:- import_module ml_backend__ml_code_util.
:- import_module ml_backend__mlds.
:- import_module parse_tree__prog_data.

:- pred ml_string_switch__generate(cases_list::in, prog_var::in,
	code_model::in, can_fail::in, prog_context::in,
	mlds__defns::out, mlds__statements::out,
	ml_gen_info::in, ml_gen_info::out) is det.

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

:- implementation.

:- import_module backend_libs__builtin_ops.
:- import_module check_hlds__type_util.
:- import_module libs__globals.
:- import_module libs__options.
:- import_module ml_backend__ml_code_gen.
:- import_module ml_backend__ml_simplify_switch.
:- import_module ml_backend__ml_switch_gen.

:- import_module bool, int, string, list, map, std_util, assoc_list, require.

ml_string_switch__generate(Cases, Var, CodeModel, _CanFail, Context,
		Decls, Statements, !Info) :-
	MLDS_Context = mlds__make_context(Context),
	%
	% Compute the value we're going to switch on
	%
	ml_gen_var(!.Info, Var, VarLval),
	VarRval = lval(VarLval),

	%
	% Generate the following local variable declarations:
	%	int slot;
	%	MR_String str;
	%
	ml_gen_info_new_cond_var(SlotVarSeq, !Info),
	SlotVarName = mlds__var_name(
		string__format("slot_%d", [i(SlotVarSeq)]), no),
	SlotVarType = mlds__native_int_type,
	SlotVarGCTraceCode = no, % never need to trace ints
	SlotVarDefn = ml_gen_mlds_var_decl(var(SlotVarName), SlotVarType,
		SlotVarGCTraceCode, MLDS_Context),
	ml_gen_var_lval(!.Info, SlotVarName, SlotVarType, SlotVarLval),

	ml_gen_info_new_cond_var(StringVarSeq, !Info),
	StringVarName = mlds__var_name(
		string__format("str_%d", [i(StringVarSeq)]), no),
	StringVarType = ml_string_type,
	% This variable always points to an element of the string_table array,
	% which are all static constants; it can never point into the heap.
	% So the GC never needs to trace it
	StringVarGCTraceCode = no,
	StringVarDefn = ml_gen_mlds_var_decl(var(StringVarName),
		StringVarType, StringVarGCTraceCode, MLDS_Context),
	ml_gen_var_lval(!.Info, StringVarName, StringVarType, StringVarLval),

	%
	% Generate new labels
	%
	ml_gen_new_label(EndLabel, !Info),
	GotoEndStatement = mlds__statement(goto(label(EndLabel)),
		MLDS_Context),

	% Determine how big to make the hash table.
	% Currently we round the number of cases up to the nearest power
	% of two, and then double it.  This should hopefully ensure that
	% we don't get too many hash collisions.
	%
	list__length(Cases, NumCases),
	int__log2(NumCases, LogNumCases),
	int__pow(2, LogNumCases, RoundedNumCases),
	TableSize = 2 * RoundedNumCases,
	HashMask = TableSize - 1,

	% Compute the hash table
	%
	switch_util__string_hash_cases(Cases, HashMask, HashValsMap),
	map__to_assoc_list(HashValsMap, HashValsList),
	switch_util__calc_hash_slots(HashValsList, HashValsMap, HashSlotsMap),

		% Generate the code for when the hash lookup fails.
		%
	ml_gen_failure(CodeModel, Context, FailStatements, !Info),

		% Generate the code etc. for the hash table
		%
	ml_string_switch__gen_hash_slots(0, TableSize, HashSlotsMap, CodeModel,
		Context, Strings, NextSlots, SlotsCases, !Info),

	%
	% Generate the following local constant declarations:
	%	static const int next_slots_table = { <NextSlots> };
	%	static const MR_String string_table[] = { <Strings> };
	%
	ml_gen_info_new_const(NextSlotsSeq, !Info),
	ml_format_static_const_name(!.Info, "next_slots_table", NextSlotsSeq,
		NextSlotsName),
	NextSlotsType = mlds__array_type(SlotVarType),
	NextSlotsDefn = ml_gen_static_const_defn(NextSlotsName,
		NextSlotsType, local, init_array(NextSlots), Context),
	ml_gen_var_lval(!.Info, NextSlotsName, NextSlotsType, NextSlotsLval),

	ml_gen_info_new_const(StringTableSeq, !Info),
	ml_format_static_const_name(!.Info, "string_table", StringTableSeq,
		StringTableName),
	StringTableType = mlds__array_type(StringVarType),
	StringTableDefn = ml_gen_static_const_defn(StringTableName,
		StringTableType, local, init_array(Strings), Context),
	ml_gen_var_lval(!.Info, StringTableName, StringTableType,
		StringTableLval),

	%
	% Generate code which does the hash table lookup.
	%

	SwitchStmt0 = switch(SlotVarType, lval(SlotVarLval),
		range(0, TableSize - 1), SlotsCases, default_is_unreachable),
	ml_simplify_switch(SwitchStmt0, MLDS_Context, SwitchStatement, !Info),

	FoundMatchCond =
		binop(and,
			binop(ne,
				lval(StringVarLval),
				const(null(StringVarType))),
			binop(str_eq,
				lval(StringVarLval),
				VarRval)
		),
	FoundMatchCode = mlds__statement(
		block([], [
			mlds__statement(atomic(comment(
				"we found a match")),
				MLDS_Context),
			mlds__statement(atomic(comment(
			"dispatch to the corresponding code")),
				MLDS_Context),
			SwitchStatement,
			GotoEndStatement
		]),
		MLDS_Context),
	LoopBody = ml_gen_block([], [
		mlds__statement(atomic(comment(
			"lookup the string for this hash slot")),
			MLDS_Context),
		mlds__statement(
			atomic(assign(StringVarLval,
				binop(array_index(elem_type_string),
					lval(StringTableLval),
					lval(SlotVarLval)))),
			MLDS_Context),
		mlds__statement(atomic(comment(
			"did we find a match?")),
			MLDS_Context),
		mlds__statement(
			if_then_else(FoundMatchCond, FoundMatchCode,
				no),
			MLDS_Context),
		mlds__statement(atomic(comment(
		      "no match yet, so get next slot in hash chain")),
			MLDS_Context),
		mlds__statement(
			atomic(assign(SlotVarLval,
				binop(array_index(elem_type_int),
					lval(NextSlotsLval),
					lval(SlotVarLval)))),
			MLDS_Context)
		],
		Context),
	HashLookupStatements = [
		mlds__statement(
			atomic(comment("hashed string switch")),
			MLDS_Context),
		mlds__statement(atomic(comment(
			"compute the hash value of the input string")),
			MLDS_Context),
		mlds__statement(
			atomic(assign(SlotVarLval, binop(&,
				unop(std_unop(hash_string), VarRval),
				const(int_const(HashMask))))),
			MLDS_Context),
		mlds__statement(atomic(comment(
			"hash chain loop")),
			MLDS_Context),
		mlds__statement(
			while(binop(>=, lval(SlotVarLval),
					const(int_const(0))),
				LoopBody,
				yes), % this is a do...while loop
			MLDS_Context)
		],
	FailComment =
		mlds__statement(
			atomic(comment("no match, so fail")),
			MLDS_Context),
	EndLabelStatement =
		mlds__statement(
			label(EndLabel),
			MLDS_Context),
	EndComment =
		mlds__statement(
			atomic(comment("end of hashed string switch")),
			MLDS_Context),

	%
	% Collect all the generated variable/constant declarations
	% and code fragments together.
	%
	Decls = [NextSlotsDefn, StringTableDefn,
		SlotVarDefn, StringVarDefn],
	Statements = HashLookupStatements ++
		[FailComment | FailStatements] ++
		[EndLabelStatement, EndComment].

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

:- pred ml_string_switch__gen_hash_slots(int::in, int::in,
	map(int, hash_slot)::in, code_model::in, prog_context::in,
	list(mlds__initializer)::out, list(mlds__initializer)::out,
	list(mlds__switch_case)::out,
	ml_gen_info::in, ml_gen_info::out) is det.

ml_string_switch__gen_hash_slots(Slot, TableSize, HashSlotMap, CodeModel,
		Context, Strings, NextSlots, MLDS_Cases, !Info) :-
	( Slot = TableSize ->
		Strings = [],
		NextSlots = [],
		MLDS_Cases = []
	;
		MLDS_Context = mlds__make_context(Context),
		ml_string_switch__gen_hash_slot(Slot, HashSlotMap,
			CodeModel, MLDS_Context, String, NextSlot, SlotCases,
			!Info),
		ml_string_switch__gen_hash_slots(Slot + 1, TableSize,
			HashSlotMap, CodeModel, Context,
			Strings0, NextSlots0, MLDS_Cases0, !Info),
		Strings = [String | Strings0],
		NextSlots = [NextSlot | NextSlots0],
		MLDS_Cases = SlotCases ++ MLDS_Cases0
	).

:- pred ml_string_switch__gen_hash_slot(int::in, map(int, hash_slot)::in,
	code_model::in, mlds__context::in, mlds__initializer::out,
	mlds__initializer::out, list(mlds__switch_case)::out,
	ml_gen_info::in, ml_gen_info::out) is det.

ml_string_switch__gen_hash_slot(Slot, HashSlotMap, CodeModel, MLDS_Context,
		init_obj(StringRval), init_obj(NextSlotRval), MLDS_Cases,
		!Info) :-
	( map__search(HashSlotMap, Slot, hash_slot(Case, Next)) ->
		NextSlotRval = const(int_const(Next)),
		Case = case(_, ConsTag, _, Goal),
		( ConsTag = string_constant(String0) ->
			String = String0
		;
			error("ml_string_switch__gen_hash_slots: " ++
				"string expected")
		),
		StringRval = const(string_const(String)),
		ml_gen_goal(CodeModel, Goal, GoalStatement, !Info),

		string__append_list(["case """, String, """"],
			CommentString),
		Comment = mlds__statement(
			atomic(comment(CommentString)),
			MLDS_Context),
		CaseStatement = mlds__statement(
			block([], [Comment, GoalStatement]),
			MLDS_Context),
		MLDS_Cases = [[match_value(const(int_const(Slot)))] -
			CaseStatement]
	;
		StringRval = const(null(ml_string_type)),
		NextSlotRval = const(int_const(-2)),
		MLDS_Cases = []
	).