diff: fixes for demangling

[Fergus Henderson]

Hi,

Anyone want to review this change?

--

Ensure that all names are properly demangled, both by mdemangle
and in the profiler.

util/mdemangle.c:
	Add code to demangle the special-case names properly.

tests/misc_tests/mdemangle_test.inp:
tests/misc_tests/mdemangle_test.exp:
	Modify the expected output to reflect the bug fix to util/demangle.c.

profiler/demangle.m:
	New module: contains a procedure for demangling Mercury labels.

profiler/demangle_test.m:
	Test harness for demangle.m.  Duplicates the functionality of
	util/demangle.c.  (Currently not used for anything except testing,
	but we might one day want to use this code to replace util/demangle.c)

profiler/read.m:
	Use the code in demangle.m to demangle labels.

Index: util/mdemangle.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/util/mdemangle.c,v
retrieving revision 1.18
diff -u -r1.18 mdemangle.c
--- mdemangle.c	1997/06/05 05:50:09	1.18
+++ mdemangle.c	1997/07/23 19:40:08
@@ -13,6 +13,12 @@
 ** A mercury symbol demangler.
 ** This is used to convert error messages from the linker back
 ** into a form that users can understand.
+**
+** This is implemented in C to minimize startup time and memory usage.
+**
+** BEWARE:
+** This code is duplicated in profiler/demangle.m and profiler/mdemangle.m.
+** Any changes here will need to be duplicated there and vice versa.
 */
 
 #include <ctype.h>
@@ -25,6 +31,7 @@
 static bool check_for_suffix(char *start, char *position, const char *suffix,
 		int sizeof_suffix, int *mode_num2);
 static char *fix_mangled_ascii(char *str, char **end);
+static bool fix_mangled_special_case(char *str, char **end);
 static bool cut_at_double_underscore(char **str, char *end);
 static bool cut_trailing_integer(char *str, char **end, int *num);
 static bool cut_trailing_underscore_integer(char *str, char **end, int *num);
@@ -73,10 +80,6 @@
 /*
 ** demangle() - convert a mangled Mercury identifier into 
 ** human-readable form and then print it to stdout
-**
-** Sorry, the following code is still fairly awful.
-** It ought to be rewritten in a language with
-** better string-handling facilities than C!
 */
 
 static void 
@@ -499,17 +502,13 @@
 	/*
 	** The compiler changes all names starting with `f_' so that
 	** they start with `f__' instead, and uses names starting with
-	** `f_' for mangled names which are sequences of decimal
+	** `f_' for mangled names which are either descriptions (such
+	** as `f_greater_than' for `>') or sequences of decimal
 	** reprententations of ASCII codes separated by underscores.
 	** If the name starts with `f__', we must change it back to
 	** start with `f_'.  Otherwise, if it starts with `f_' we must
-	** convert the list of ASCII codes back into an identifier.
-	** 
-	** XXX Note: some symbols are special cased - eg `!' becomes
-	** `f_cut', we should probably translate these special cases
-	** back (see llds_out.m for the special cases). Presently, just
-	** the `f_' will be removed, which still leaves them quite
-	** readable.
+	** convert the mnemonic or list of ASCII codes back into an
+	** identifier.
 	*/
 
 static char *
@@ -517,10 +516,30 @@
 {
 	char *end = *real_end;
 
+	/*
+	** If it starts with `f__', replace that with `f_'.
+	*/
 	if (strncmp(str, "f__" , 3) == 0) {
 		str++;
 		*str = 'f';
-	} else if (strncmp(str, "f_", 2) == 0) {
+		return str;
+	}
+
+	/*
+	** If it starts with `f_' followed by a mnemonic description,
+	** then replace that with its unmangled version
+	*/
+	if (strncmp(str, "f_", 2) == 0 &&
+		fix_mangled_special_case(str, real_end))
+	{
+		return str;
+	}
+
+	/*
+	** Otherwise, if it starts with `f_' we must convert the list of
+	** ASCII codes back into an identifier.
+	*/
+	if (strncmp(str, "f_", 2) == 0) {
 		char buf[1000];
 		char *num = str + 2;
 		int count = 0;
@@ -546,6 +565,59 @@
 	return str;
 }
 
+static bool
+fix_mangled_special_case(char *str, char **real_end)
+{
+	static const struct {
+		const char *mangled_name;
+		const char *unmangled_name;
+	} translations[] = {
+		/*
+		** Beware: we assume that the unmangled name is always
+		** shorter than the mangled name.
+		*/
+		{ "f_not_equal", "\\=" },
+		{ "f_greater_or_equal", ">=" },
+		{ "f_less_or_equal", "=<" },
+		{ "f_equal", "=" },
+		{ "f_less_than", "<" },
+		{ "f_greater_than", ">" },
+		{ "f_plus", "+" },
+		{ "f_times", "*" },
+		{ "f_minus", "-" },
+		{ "f_slash", "/" },
+		{ "f_comma", "," },
+		{ "f_semicolon", ";" },
+		{ "f_cut", "!" }
+	};
+	const int num_translations =
+		sizeof(translations) / sizeof(translations[0]);
+
+	int i;
+
+	/*
+	** check for the special cases listed in the table above.
+	*/
+	for (i = 0; i < num_translations; i++) {
+		const char *mangled = translations[i].mangled_name;
+		size_t mangled_len = strlen(mangled);
+		if (strncmp(str, mangled, mangled_len) == 0) {
+			const char *unmangled = translations[i].unmangled_name;
+			size_t unmangled_len = strlen(unmangled);
+			size_t leftover_len = strlen(str) - mangled_len;
+
+			assert(unmangled_len <= mangled_len);
+
+			strcpy(str, unmangled);
+			memmove(str + unmangled_len, str + mangled_len,
+				leftover_len + 1);
+
+			*real_end = str + unmangled_len + leftover_len;
+			return TRUE;
+		}
+	}
+	return FALSE;
+}
 
 static bool 
 check_for_suffix(char *start, char *position, const char *suffix,
Index: tests/misc_tests/mdemangle_test.inp
===================================================================
RCS file: /home/staff/zs/imp/tests/misc_tests/mdemangle_test.inp,v
retrieving revision 1.5
diff -u -r1.5 mdemangle_test.inp
--- mdemangle_test.inp	1997/06/05 05:50:16	1.5
+++ mdemangle_test.inp	1997/07/23 19:42:16
@@ -28,7 +28,7 @@
 
 	a mangled name
 entry_mercury__f_cut_0_0
-<predicate 'cut'/0 mode 0>
+<predicate '!'/0 mode 0>
 
 	a compare predicate
 entry_mercury____Compare___mercury_builtin__comparison_result_0_0
Index: tests/misc_tests/mdemangle_test.exp
===================================================================
RCS file: /home/staff/zs/imp/tests/misc_tests/mdemangle_test.exp,v
retrieving revision 1.5
diff -u -r1.5 mdemangle_test.exp
--- mdemangle_test.exp	1997/06/07 08:22:06	1.5
+++ mdemangle_test.exp	1997/07/23 19:41:07
@@ -27,8 +27,8 @@
 <type layout for type 'float'/0>
 
 	a mangled name
-<predicate 'cut'/0 mode 0>
-<predicate 'cut'/0 mode 0>
+<predicate '!'/0 mode 0>
+<predicate '!'/0 mode 0>
 
 	a compare predicate
 <compare/3 predicate for type 'mercury_builtin:comparison_result'/0>
Index: profiler/demangle.m
===================================================================
RCS file: demangle.m
diff -N demangle.m
--- /dev/null	Thu Jul 24 06:02:47 1997
+++ demangle.m	Thu Jul 24 06:00:25 1997
@@ -0,0 +1,496 @@
+%-----------------------------------------------------------------------------%
+%
+% Copyright (C) 1997 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: demangle.m
+% Author: fjh
+%
+% A mercury symbol demangler.
+% This is used to convert symbol names back
+% into a form that users can understand.
+%
+% BEWARE: the code here is duplicated in util/mdemangle.c,
+% so any changes here will need to be duplicated there.
+%
+%-----------------------------------------------------------------------------%
+
+:- module demangle.
+:- interface.
+:- import_module string.
+
+:- pred demangle(string::in, string::out) is det.
+
+/*---------------------------------------------------------------------------*/
+
+:- implementation.
+:- import_module int, list, char, std_util, bool, require.
+
+:- type pred_category ---> index ; unify ; compare ; ordinary.
+:- type data_category ---> common ; info ; layout ; functors.
+
+demangle(MangledName, Name) :-
+	( demangle_from_asm(MangledName, DemangledName) ->
+		Name = DemangledName
+	;
+		Name = MangledName
+	).
+
+:- pred demangle_from_asm(string, string).
+:- mode demangle_from_asm(in, out) is semidet.
+demangle_from_asm -->
+	% skip any leading underscore inserted by the C compiler
+	maybe_remove_prefix("_"),
+
+	% skip the `entry_' prefix, if any
+	maybe_remove_prefix("entry_"),
+
+	demangle_from_c.
+
+:- pred demangle_from_c(string, string).
+:- mode demangle_from_c(in, out) is semidet.
+demangle_from_c -->
+	( demangle_proc ->
+		{ true }
+	; demangle_data ->
+		{ true }
+	;
+		{ fail }
+	).
+
+/*---------------------------------------------------------------------------*/
+
+:- pred demangle_proc(string, string).
+:- mode demangle_proc(in, out) is semidet.
+demangle_proc -->
+	remove_prefix("mercury__"),
+
+	%
+	% strip off the `fn__' prefix, if any
+	%
+	( remove_prefix("fn__") ->
+		{ PredOrFunc = "function" }
+	;
+		{ PredOrFunc = "predicate" }
+	),
+
+	%
+	% Get integer from end of string (it might be the mode number,
+	% it might be the internal label number).
+	%
+	remove_trailing_int(Int),
+
+	( m_remove_suffix("i") ->
+		%
+		% if we got to an `i', that means it is an internal
+		% label of the form `mercury__append_3_0_i1'
+		% in that case, save the internal label number and then
+		% get the mode number
+		%
+		{ MaybeInternalLabelNum = yes(Int) },
+		m_remove_suffix("_"),
+		remove_trailing_int(ModeNum)
+	;
+		{ MaybeInternalLabelNum = no },
+		{ ModeNum = Int }
+	),
+
+	%
+	% scan back past the arity number and then parse it
+	%
+	m_remove_suffix("_"),
+	remove_trailing_int(Arity),
+	m_remove_suffix("_"),
+
+	%
+	% Now start processing from the start of the string again.
+	% Check whether the start of the string matches the name of
+	% one of the special compiler-generated predicates; if so,
+	% set the `category' to the appropriate value and then
+	% skip past the prefix.
+	%
+	( remove_prefix("__Unify__") ->
+		{ Category = unify }
+	; remove_prefix("__Compare__") ->
+		{ Category = compare },
+		{ ModeNum = 0 } % sanity check
+	; remove_prefix("__Index__") ->
+		{ Category = index },
+		{ ModeNum = 0 } % sanity check
+	;	
+		{ Category = ordinary }
+	),
+
+	%
+	% Fix any ascii codes mangled in the predicate name
+	%
+	fix_mangled_ascii,
+
+	%
+	% Process the mangling introduced by unused_args.m.
+	% This involves stripping off the `__ua<m>' or `__uab<m>' added to 
+	% the end of the predicate/function name, where m is the mode number.
+	% 
+	(
+		remove_trailing_int(_UA_ModeNum),
+		m_remove_suffix("__ua")
+	->
+		{ UnusedArgs = yes }
+	;
+		remove_trailing_int(_UA_ModeNum),
+		m_remove_suffix("__uab")
+	->
+		{ UnusedArgs = yes }
+	;
+		{ UnusedArgs = no }
+	),
+		
+	%
+	% Process the mangling introduced by higher_order.m.
+	% This involves stripping off the `__ho<n>' where
+	% n is a unique identifier for this specialized version
+	%
+	(
+		remove_trailing_int(_HO_ModeNum),
+		m_remove_suffix("__ho")
+	->
+		{ HigherOrder = yes }
+	;
+		{ HigherOrder = no }
+	),
+
+	%
+	% Separate the module name from the type name for the compiler
+	% generated predicates.
+	%
+	( { Category \= ordinary } ->
+		remove_prefix("_"),
+		remove_maybe_module_prefix(MaybeModule),
+		{ MaybeModule \= yes("") }
+	;
+		{ MaybeModule = no }
+	),
+		
+	%
+	% Make sure special predicates with unused_args 
+	% are reported correctly.
+	%
+
+	( { UnusedArgs = yes, Category \= ordinary } ->
+		remove_trailing_int(Arity)
+	;
+		{ true }
+	),
+
+	%
+	% Now, finally, we can construct the demangled symbol name
+	%
+	=(PredName),
+	{ format_proc(Category, MaybeModule, PredOrFunc, PredName,
+		Arity, ModeNum, HigherOrder, UnusedArgs, MaybeInternalLabelNum,
+		Parts, []) },
+	{ string__append_list(Parts, DemangledName) },
+	dcg_set(DemangledName).
+
+:- pred format_proc(pred_category, maybe(string), string, string, int, int,
+		bool, bool, maybe(int), list(string), list(string)).
+:- mode format_proc(in, in, in, in, in, in, in, in, in, out, in) is det.
+format_proc(Category, MaybeModule, PredOrFunc, PredName, Arity, ModeNum, 
+		HigherOrder, UnusedArgs, MaybeInternalLabelNum) -->
+	["<"],
+	{
+		Category = unify,
+		get_maybe(MaybeModule, Module),
+		string__format("unification predicate for type '%s:%s'/%d mode %d",
+			[s(Module), s(PredName), i(Arity), i(ModeNum)],
+			MainPart)
+	;
+		Category = compare,
+		get_maybe(MaybeModule, Module),
+		string__format("compare/3 predicate for type '%s:%s'/%d",
+			[s(Module), s(PredName), i(Arity)],
+			MainPart)
+	;
+		Category = index,
+		get_maybe(MaybeModule, Module),
+		string__format("index/2 predicate for type '%s:%s'/%d",
+			[s(Module), s(PredName), i(Arity)],
+			MainPart)
+	;
+		Category = ordinary,
+		string__format("%s '%s'/%d mode %d",
+			[s(PredOrFunc), s(PredName), i(Arity), i(ModeNum)],
+			MainPart)
+	},
+	[MainPart],
+	( { HigherOrder = yes } ->
+		[" (specialized)"]
+	;
+		[]
+	),
+	( { UnusedArgs = yes } ->
+		[" (minus unused args)"]
+	;
+		[]
+	),
+	( { MaybeInternalLabelNum = yes(Internal) } ->
+		{ string__format(" label %d", [i(Internal)], Label) },
+		[Label]
+	;
+		[]
+	),
+	[">"].
+
+/*---------------------------------------------------------------------------*/
+
+% 
+% Code to deal with mercury_data items.
+%
+
+:- pred demangle_data(string, string).
+:- mode demangle_data(in, out) is semidet.
+demangle_data -->
+	remove_prefix("mercury_data_"),
+	remove_maybe_module_prefix(MaybeModule0),
+	{ MaybeModule0 = yes("") ->
+		MaybeModule = no
+	;
+		MaybeModule = MaybeModule0
+	},
+	( remove_prefix("base_type_info_") ->
+		{ DataCategory = info },
+		remove_trailing_int(Arity),
+		m_remove_suffix("_")
+	; remove_prefix("base_type_layout_") ->
+		{ DataCategory = layout },
+		remove_trailing_int(Arity),
+		m_remove_suffix("_")
+	; remove_prefix("base_type_functors_") ->
+		{ DataCategory = functors },
+		remove_trailing_int(Arity),
+		m_remove_suffix("_")
+	; remove_prefix("common_") ->
+		{ DataCategory = common },
+		remove_trailing_int(Arity)
+	;
+		{ fail }
+	),
+
+	fix_mangled_ascii,
+
+	=(Name),
+	{ format_data(DataCategory, MaybeModule, Name, Arity, Result) },
+	dcg_set(Result).
+
+:- pred format_data(data_category, maybe(string), string, int, string).
+:- mode format_data(in, in, in, in, out) is semidet.
+format_data(info, MaybeModule, Name, Arity, Result) :-
+	( MaybeModule = yes(Module) ->
+		string__format("<base type_info for type '%s:%s'/%d>",
+			[s(Module), s(Name), i(Arity)], Result)
+	;
+		string__format("<base type_info for type '%s'/%d>",
+			[s(Name), i(Arity)], Result)
+	).
+format_data(layout, MaybeModule, Name, Arity, Result) :-
+	( MaybeModule = yes(Module) ->
+		string__format("<type layout for type '%s:%s'/%d>",
+			[s(Module), s(Name), i(Arity)], Result)
+	;
+		string__format("<type layout for type '%s'/%d>",
+			[s(Name), i(Arity)], Result)
+	).
+format_data(functors, MaybeModule, Name, Arity, Result) :-
+	( MaybeModule = yes(Module) ->
+		string__format("<type functors for type '%s:%s'/%d>",
+			[s(Module), s(Name), i(Arity)], Result)
+	;
+		string__format("<type functors for type '%s'/%d>",
+			[s(Name), i(Arity)], Result)
+	).
+format_data(common, MaybeModule, _Name, Arity, Result) :-
+	( MaybeModule = yes(Module) ->
+		string__format("<shared constant number %d for module %s>",
+			[i(Arity), s(Module)], Result)
+	;
+		fail
+	).
+
+/*---------------------------------------------------------------------------*/
+
+	%
+	% The compiler changes all names starting with `f_' so that
+	% they start with `f__' instead, and uses names starting with
+	% `f_' for mangled names which are either descriptions (such
+	% as `f_greater_than' for `>') or sequences of decimal
+	% reprententations of ASCII codes separated by underscores.
+	% If the name starts with `f__', we must change it back to
+	% start with `f_'.  Otherwise, if it starts with `f_' we must
+	% convert the mnemonic or list of ASCII codes back into an
+	% identifier.
+	%
+
+:- pred fix_mangled_ascii(string, string).
+:- mode fix_mangled_ascii(in, out) is semidet.
+fix_mangled_ascii -->
+	( remove_prefix("f__") ->
+		insert_prefix("f_")
+	; remove_prefix("f_not_equal") ->
+		insert_prefix("\\=")
+	; remove_prefix("f_greater_or_equal") ->
+		insert_prefix(">=")
+	; remove_prefix("f_less_or_equal") ->
+		insert_prefix("=<")
+	; remove_prefix("f_equal") ->
+		insert_prefix("=")
+	; remove_prefix("f_less_than") ->
+		insert_prefix("<")
+	; remove_prefix("f_greater_than") ->
+		insert_prefix(">")
+	; remove_prefix("f_minus") ->
+		insert_prefix("-")
+	; remove_prefix("f_plus") ->
+		insert_prefix("+")
+	; remove_prefix("f_times") ->
+		insert_prefix("*")
+	; remove_prefix("f_slash") ->
+		insert_prefix("/")
+	; remove_prefix("f_comma") ->
+		insert_prefix(",")
+	; remove_prefix("f_semicolon") ->
+		insert_prefix(";")
+	; remove_prefix("f_cut") ->
+		insert_prefix("!")
+	; remove_prefix("f_") ->
+		fix_mangled_ascii_chars
+	;
+		[]
+	).
+
+:- pred fix_mangled_ascii_chars(string, string).
+:- mode fix_mangled_ascii_chars(in, out) is semidet.
+fix_mangled_ascii_chars -->
+	remove_int(I),
+	( remove_prefix("_") ->
+		fix_mangled_ascii_chars
+	;
+		[]
+	),
+	{ char__to_int(C, I) },
+	insert_prefix_char(C).
+
+/*---------------------------------------------------------------------------*/
+
+:- pred remove_int(int, string, string).
+:- mode remove_int(out, in, out) is semidet.
+remove_int(Int) -->
+	remove_digit(Digit),
+	remove_int_2(Digit, Int).
+
+:- pred remove_int_2(int, int, string, string).
+:- mode remove_int_2(in, out, in, out) is semidet.
+remove_int_2(Int0, Int) -->
+	( remove_digit(Next) ->
+		{ Int1 is Int0 * 10 + Next },
+		remove_int_2(Int1, Int)
+	;
+		{ Int = Int0 }
+	).
+
+:- pred remove_digit(int, string, string).
+:- mode remove_digit(out, in, out) is semidet.
+remove_digit(Digit, String0, String) :-
+	string__first_char(String0, Char, String),
+	digit(Char, Digit).
+
+:- pred digit(character, int).
+:- mode digit(in, uo) is semidet.
+digit('0', 0).
+digit('1', 1).
+digit('2', 2).
+digit('3', 3).
+digit('4', 4).
+digit('5', 5).
+digit('6', 6).
+digit('7', 7).
+digit('8', 8).
+digit('9', 9).
+
+/*---------------------------------------------------------------------------*/
+
+:- pred remove_maybe_module_prefix(maybe(string), string, string).
+:- mode remove_maybe_module_prefix(out, in, out) is det.
+remove_maybe_module_prefix(MaybeModule, String0, String) :-
+	( string__sub_string_search(String0, "__", Index) ->
+		string__left(String0, Index, Module),
+		string__length(String0, Len),
+		Index2 is Index + 2,
+		string__substring(String0, Index2, Len, String),
+		MaybeModule = yes(Module)
+	;
+		String = String0,
+		MaybeModule = no
+	).
+
+:- pred maybe_remove_prefix(string, string, string).
+:- mode maybe_remove_prefix(in, in, out) is det.
+maybe_remove_prefix(Prefix) -->
+	( remove_prefix(Prefix) -> [] ; [] ).
+
+:- pred remove_prefix(string, string, string).
+:- mode remove_prefix(in, in, out) is semidet.
+remove_prefix(Prefix, Name0, Name) :-
+	string__append(Prefix, Name, Name0).
+
+:- pred m_remove_suffix(string, string, string).
+:- mode m_remove_suffix(in, in, out) is semidet.
+m_remove_suffix(Suffix, Name0, Name) :-
+	string__remove_suffix(Name0, Suffix, Name).
+
+:- pred insert_prefix(string, string, string).
+:- mode insert_prefix(in, in, out) is det.
+insert_prefix(Prefix, Name0, Name) :-
+	string__append(Prefix, Name0, Name).
+
+:- pred insert_prefix_char(char, string, string).
+:- mode insert_prefix_char(in, in, out) is det.
+insert_prefix_char(Prefix, Name0, Name) :-
+	string__first_char(Name, Prefix, Name0).
+
+:- pred dcg_set(T1, T2, T1).
+:- mode dcg_set(in, in, out) is det.
+dcg_set(X, _, X).
+
+:- pred get_maybe((std_util:maybe(T)), T).
+:- mode get_maybe(in, out) is det.
+get_maybe(no, _) :- error("get_maybe").
+get_maybe(yes(X), X).
+
+:- pred remove_trailing_int(int, string, string).
+:- mode remove_trailing_int(out, in, out) is semidet.
+remove_trailing_int(Int) -->
+	remove_trailing_digit(Digit),
+	( remove_trailing_int(Rest) ->
+		{ Int is Rest * 10 + Digit }
+	;
+		{ Int = Digit }
+	).
+
+:- pred remove_trailing_digit(int, string, string).
+:- mode remove_trailing_digit(out, in, out) is semidet.
+remove_trailing_digit(Digit, String0, String) :-
+	string_last_char(String0, Char, String),
+	digit(Char, Digit).
+
+:- pred string_last_char(string, character, string).
+:- mode string_last_char(in, out, out) is semidet.
+string_last_char(String0, Char, String) :-
+	string__length(String0, Len),
+	Len1 is Len - 1,
+	string__index(String0, Len1, Char),
+	string__left(String0, Len1, String).
+
+/*---------------------------------------------------------------------------*/
Index: profiler/demangle_test.m
===================================================================
RCS file: demangle_test.m
diff -N demangle_test.m
--- /dev/null	Thu Jul 24 06:02:47 1997
+++ demangle_test.m	Thu Jul 24 05:55:40 1997
@@ -0,0 +1,76 @@
+%-----------------------------------------------------------------------------%
+%
+% Copyright (C) 1997 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: mdemangle.m
+% Author: fjh
+%
+% Front-end to a mercury symbol demangler.
+% This is used to convert error messages from the linker back
+% into a form that users can understand.
+%
+% BEWARE:
+% The code here duplicates the functionality of util/mdemangle.c.
+% Any changes here will require corresponding changes there.
+%
+% We might eventually replace util/mdemangle.c with this Mercury version.
+%
+%-----------------------------------------------------------------------------%
+
+:- module mdemangle.
+:- interface.
+
+:- import_module io.
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module demangle.
+:- import_module list, char, string.
+
+main -->
+	io__command_line_arguments(Args),
+	( { Args \= [] } ->
+		%
+		% invoke demangle/2 on each command line argument
+		%
+		{ list__map(demangle, Args, DemangledArgs) },
+		io__write_list(DemangledArgs, "\n", io__write_string), io__nl
+	;
+		%
+		% copy stdin to stdout, calling demangle/2 for
+		% every valid C identifier in the input
+		%
+		demangle_stdin([])
+	).
+
+:- pred demangle_stdin(list(char)::in, state::di, state::uo) is det.
+demangle_stdin(RevChars) -->
+	io__read_char(Result),
+	( { Result = ok(Char) },
+		( { char__is_alnum_or_underscore(Char) } ->
+			demangle_stdin([Char | RevChars])
+		;
+			{ string__from_rev_char_list(RevChars, MangledName) },
+			{ demangle(MangledName, DemangledName) },
+			io__write_string(DemangledName),
+			io__write_char(Char),
+			demangle_stdin([])
+		)
+	; { Result = eof },
+		{ string__from_rev_char_list(RevChars, MangledName) },
+		{ demangle(MangledName, DemangledName) },
+		io__write_string(DemangledName)
+	; { Result = error(Error) },
+		{ io__error_message(Error, Message) },
+		io__input_stream_name(StreamName),
+		io__progname("mdemangle", ProgName),
+		io__write_strings([ProgName, ": ",
+			"error reading input file `", StreamName, "': \n\t",
+			Message, "\n"])
+	).
+
+%-----------------------------------------------------------------------------%
Index: profiler/read.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/profiler/read.m,v
retrieving revision 1.5
diff -u -r1.5 read.m
--- read.m	1997/07/01 04:12:01	1.5
+++ read.m	1997/07/23 18:50:25
@@ -85,8 +85,8 @@
 	io__read_word(WordResult),
 	(
 		{ WordResult = ok(CharList0) },
-		{ label_demangle(CharList0, CharList) },
-		{ string__from_char_list(CharList, LabelName) },
+		{ string__from_char_list(CharList0, LabelName0) },
+		{ demangle(LabelName0, LabelName) },
 		{ MaybeLabelName = yes(LabelName) }
 	;
 		{ WordResult = eof },
@@ -137,8 +137,8 @@
 	io__read_word(WordResult),
 	(
 		{ WordResult = ok(CharList0) },
-		{ label_demangle(CharList0, CharList) },
-		{ string__from_char_list(CharList, LabelName) }
+		{ string__from_char_list(CharList0, LabelName0) },
+		{ demangle(LabelName0, LabelName) },
 	;
 		{ WordResult = eof },
 		{ error("read_label_name: EOF reached") }
@@ -177,39 +177,3 @@
 	).
 
 %-----------------------------------------------------------------------------%
-
-:- pred label_demangle(list(char), list(char)).
-:- mode label_demangle(in, out) is det.
-
-label_demangle(CharList0, CharList) :-
-	(
-		CharList0 = ['m','e','r','c','u','r','y','_','_' | CharList1]
-	->
-		demangle_arity_and_mode(CharList1, CharList)
-	;
-		CharList = CharList0
-	).
-
-
-:- pred demangle_arity_and_mode(list(char), list(char)).
-:- mode demangle_arity_and_mode(in, out) is det.
-
-demangle_arity_and_mode(CharList0, CharList) :-
-	list__reverse(CharList0, CharList1),
-	CharList2 = [')' | CharList1],
-	read__replace(CharList2, '_', '(', CharList3),
-	read__replace(CharList3, '_', '/', CharList4),
-	list__reverse(CharList4, CharList).
-
-
-:- pred read__replace(list(char), char, char, list(char)).
-:- mode read__replace(in, in, in, out) is det.
-
-read__replace(L0, D, R, L) :-
-	(
-		list__replace_first(L0, D, R, L1)
-	->
-		L = L1
-	;
-		error("demangle_label: ill formed label\n")
-	).

-- 
Fergus Henderson <fjh at cs.mu.oz.au>   |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>   |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3         |     -- the last words of T. S. Garp.