[m-rev.] diff: move attributes implementation from dotnet-foreign to main

[Tyson Dowd]

Hi,

Another change from the dotnet-foreign branch.  I intend to use the 
MLDS attributes to record some other useful information so I decided to
port this change from the dotnet-foreign branch first and build on it.

===================================================================


Estimated hours taken: 2
Branches: main

Merge changes to add attributes to the HLDS, MLDS and ILDS from the
dotnet-foreign branch.  We don't merge the changes to add syntax for
attributes, as the syntax is still very experimental.

compiler/hlds_pred.m:
compiler/prog_data.m:
	Add attributes to the pred_info (they are a bit like markers,
	but are more than just boolean flags).

compiler/ilasm.m:
	Add custom attributes to appropriate positions (on assemblies,
	IL types and methods).

compiler/ml_code_gen.m:
compiler/ml_code_util.m:
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_tailcall.m:
compiler/ml_type_gen.m:
compiler/ml_util.m:
compiler/mlds.m:
compiler/mlds_to_c.m:
compiler/mlds_to_csharp.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_java.m:
compiler/mlds_to_mcpp.m:
	Add mlds__attributes, which are the MLDS version of custom attributes.
	Convert hlds_pred__attributes into mlds__attributes.
	Add a list of mlds__attributes to the mlds__function defn.

compiler/mlds_to_il.m:
	Convert MLDS attributes to IL custom attributes.



Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.100
diff -u -r1.100 hlds_pred.m
--- compiler/hlds_pred.m	2001/08/11 14:09:39	1.100
+++ compiler/hlds_pred.m	2001/08/24 15:09:41
@@ -456,6 +456,17 @@
 				% then it must give an error message.
 	.
 
+
+	% An abstract set of attributes.
+:- type pred_attributes.
+
+:- type attribute
+	--->	custom(type)
+				% A custom attribute, indended to be associated
+				% with this predicate in the underlying
+				% implementation.
+	.
+
 	% Aditi predicates are identified by their owner as well as
 	% module, name and arity.
 :- type aditi_owner == string.
@@ -773,6 +784,12 @@
 :- pred pred_info_set_markers(pred_info, pred_markers, pred_info).
 :- mode pred_info_set_markers(in, in, out) is det.
 
+:- pred pred_info_get_attributes(pred_info, pred_attributes).
+:- mode pred_info_get_attributes(in, out) is det.
+
+:- pred pred_info_set_attributes(pred_info, pred_attributes, pred_info).
+:- mode pred_info_set_attributes(in, in, out) is det.
+
 :- pred pred_info_get_call_id(pred_info, simple_call_id).
 :- mode pred_info_get_call_id(in, out) is det.
 
@@ -799,6 +816,29 @@
 :- pred marker_list_to_markers(list(marker), pred_markers).
 :- mode marker_list_to_markers(in, out) is det.
 
+	% create an empty set of attributes
+:- pred init_attributes(pred_attributes).
+:- mode init_attributes(out) is det.
+
+	% check if a particular is in the set
+:- pred check_attribute(pred_attributes, attribute).
+:- mode check_attribute(in, in) is semidet.
+
+	% add a attribute to the set
+:- pred add_attribute(pred_attributes, attribute, pred_attributes).
+:- mode add_attribute(in, in, out) is det.
+
+	% remove a attribute from the set
+:- pred remove_attribute(pred_attributes, attribute, pred_attributes).
+:- mode remove_attribute(in, in, out) is det.
+
+	% convert the set to a list
+:- pred attributes_to_attribute_list(pred_attributes, list(attribute)).
+:- mode attributes_to_attribute_list(in, out) is det.
+
+:- pred attribute_list_to_attributes(list(attribute), pred_attributes).
+:- mode attribute_list_to_attributes(in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -892,6 +932,8 @@
 					% pragma foreign_code(...) decs, or none
 			markers		:: pred_markers,
 					% various boolean flags
+			attributes	:: pred_attributes,
+					% various attributes 
 			is_pred_or_func	:: pred_or_func,
 					% whether this "predicate" was really
 					% a predicate or a function
@@ -960,15 +1002,17 @@
 	sym_name_get_module_name(SymName, ModuleName, PredModuleName),
 	term__vars_list(Types, TVars),
 	list__delete_elems(TVars, ExistQVars, HeadTypeParams),
+	Attributes = [],
 	UnprovenBodyConstraints = [],
 	Indexes = [],
 	set__init(Assertions),
 	MaybeInstanceConstraints = no,
 	PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
 		Context, PredModuleName, PredName, Arity, Status, TypeVarSet,
-		GoalType, Markers, PredOrFunc, ClassContext, ClassProofs,
-		ExistQVars, HeadTypeParams, UnprovenBodyConstraints, User,
-		Indexes, Assertions, MaybeInstanceConstraints).
+		GoalType, Markers, Attributes, PredOrFunc, ClassContext,
+		ClassProofs, ExistQVars, HeadTypeParams,
+		UnprovenBodyConstraints, User, Indexes, Assertions,
+		MaybeInstanceConstraints).
 
 pred_info_create(ModuleName, SymName, TypeVarSet, ExistQVars, Types, Cond,
 		Context, Status, Markers, PredOrFunc, ClassContext, User,
@@ -986,6 +1030,7 @@
 	unqualify_name(SymName, PredName),
 	% The empty list of clauses is a little white lie.
 	Clauses = [],
+	Attributes = [],
 	map__init(TVarNameMap),
 	HasForeignClauses = no,
 	ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
@@ -999,9 +1044,10 @@
 	MaybeInstanceConstraints = no,
 	PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
 		Context, ModuleName, PredName, Arity, Status, TypeVarSet,
-		clauses, Markers, PredOrFunc, ClassContext, ClassProofs,
-		ExistQVars, HeadTypeParams, UnprovenBodyConstraints, User,
-		Indexes, Assertions, MaybeInstanceConstraints).
+		clauses, Markers, Attributes, PredOrFunc, ClassContext,
+		ClassProofs, ExistQVars, HeadTypeParams,
+		UnprovenBodyConstraints, User, Indexes, Assertions,
+		MaybeInstanceConstraints).
 
 pred_info_all_procids(PredInfo, ProcIds) :-
 	ProcTable = PredInfo ^ procedures,
@@ -1199,6 +1245,10 @@
 
 pred_info_set_markers(PredInfo, X, PredInfo^markers := X).
 
+pred_info_get_attributes(PredInfo, PredInfo ^ attributes).
+
+pred_info_set_attributes(PredInfo, X, PredInfo ^ attributes := X).
+
 pred_info_get_is_pred_or_func(PredInfo, PredInfo^is_pred_or_func).
 
 pred_info_set_class_context(PredInfo, X, PredInfo^class_context := X).
@@ -1279,6 +1329,23 @@
 markers_to_marker_list(Markers, Markers).
 
 marker_list_to_markers(Markers, Markers).
+
+:- type pred_attributes == list(attribute).
+
+init_attributes([]).
+
+check_attribute(Attributes, Attribute) :-
+	list__member(Attribute, Attributes).
+
+add_attribute(Attributes, Attribute, [Attribute | Attributes]).
+
+remove_attribute(Attributes0, Attribute, Attributes) :-
+	list__delete_all(Attributes0, Attribute, Attributes).
+
+attributes_to_attribute_list(Attributes, Attributes).
+
+attribute_list_to_attributes(Attributes, Attributes).
+
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ilasm.m,v
retrieving revision 1.21
diff -u -r1.21 ilasm.m
--- compiler/ilasm.m	2001/08/24 11:57:59	1.21
+++ compiler/ilasm.m	2001/08/24 15:09:42
@@ -87,6 +87,10 @@
 		% defines an assembly
 	;	assembly(ilds__id)
 
+		% .custom
+		% a custom attribute
+	;	custom(custom_decl)
+
 		% comments
 	;	comment_term(term)
 			% print almost anything using pprint__to_doc
@@ -97,7 +101,9 @@
 :- type assembly_decl 
 	--->	version(int, int, int, int)	% version number
 	;	hash(list(int8))		% hash 
-	;	public_key_token(list(int8)).	% public key token
+	;	public_key_token(list(int8))	% public key token
+	;	custom(custom_decl).		% a custom attribute
+
 
 	% a method definition is just a list of body decls.
 :- type method_defn == list(method_body_decl).
@@ -140,6 +146,7 @@
 						% implemented
 			list(class_member)	% methods and fields
 		)
+	;	custom(custom_decl)		% custom attribute
 		% comments
 	;	comment_term(term)
 	;	comment(string)
@@ -186,6 +193,7 @@
 			% words or something else?
 	;	entrypoint		% is this "main"?
 	;	zeroinit		% initialize locals to zero.
+	;	custom(custom_decl)	% custom attribute
 	;	instrs(list(instr))	% instructions
 	;	label(string).		% a label
 
@@ -246,6 +254,22 @@
 	;	bytearray(list(byte)).	% output as two digit hex, e.g.
 					% 01 F7 0A
 
+:- type custom_decl ---> 
+	custom_decl(
+		custom_type, 
+		maybe(custom_type),
+		qstring_or_bytes).
+
+:- type qstring_or_bytes
+	--->	qstring(string)
+	;	bytes(list(int8))
+	; 	no_initalizer.
+
+:- type custom_type
+	--->	type(ilds__type)
+	;	methodref(ilds__methodref).
+
+
 :- implementation.
 
 :- import_module char, string, pprint, getopt.
@@ -306,6 +330,8 @@
 :- pred ilasm__output_decl(decl::in, ilasm_info::in, ilasm_info::out,
 		io__state::di, io__state::uo) is det.
 
+ilasm__output_decl(custom(CustomDecl), Info0, Info) --> 
+	output_custom_decl(CustomDecl, Info0, Info).
 ilasm__output_decl(class(Attrs, Id, Extends, Implements, Contents),
 		Info0, Info) --> 
 	io__write_string(".class "),
@@ -398,11 +424,14 @@
 		[]
 	).
 
-ilasm__output_decl(extern_assembly(AsmName, AssemblyDecls), Info, Info) --> 
+ilasm__output_decl(extern_assembly(AsmName, AssemblyDecls), Info0, Info) --> 
 	io__write_string(".assembly extern "),
 	output_id(AsmName),
 	io__write_string("{\n"),
-	io__write_list(AssemblyDecls, "\n\t", output_assembly_decl),
+	list__foldl2((pred(A::in, I0::in, I::out, di, uo) is det -->
+			output_assembly_decl(A, I0, I),
+			io__write_string("\n\t")
+		), AssemblyDecls, Info0, Info),
 	io__write_string("\n}\n").
 
 
@@ -412,6 +441,15 @@
 	{ Info = Info0 ^ current_assembly := AsmName },
 	io__write_string(" { }").
 
+ilasm__output_decl(file(FileName), Info, Info) --> 
+	io__write_string(".file "),
+	output_id(FileName).
+
+ilasm__output_decl(extern_module(ModName), Info, Info) --> 
+	io__write_string(".module extern "),
+	output_id(ModName).
+
+
 :- pred ilasm__output_class_member(class_member::in, ilasm_info::in,
 	ilasm_info::out, io__state::di, io__state::uo) is det.
 
@@ -430,13 +468,8 @@
 			Info0, Info)
 	).
 
-ilasm__output_decl(file(FileName), Info, Info) --> 
-	io__write_string(".file "),
-	output_id(FileName).
-
-ilasm__output_decl(extern_module(ModName), Info, Info) --> 
-	io__write_string(".module extern "),
-	output_id(ModName).
+ilasm__output_class_member(custom(CustomDecl), Info0, Info) -->
+	output_custom_decl(CustomDecl, Info0, Info).
 
 ilasm__output_class_member(
 		field(FieldAttrs, Type, IlId, MaybeOffset, Initializer),
@@ -536,6 +569,9 @@
 	io__write_string(".emitbyte "),
 	output_int32(Int32).
 
+ilasm__output_method_body_decl(custom(CustomDecl), Info0, Info) -->
+	output_custom_decl(CustomDecl, Info0, Info).
+
 ilasm__output_method_body_decl(maxstack(Int32), I, I) -->
 	io__write_string(".maxstack "),
 	output_int32(Int32).
@@ -1391,19 +1427,52 @@
 output_classattr(specialname) --> io__write_string("specialname").
 output_classattr(unicode) --> io__write_string("unicode").
 
-:- pred ilasm__output_assembly_decl(assembly_decl::in, 
-	io__state::di, io__state::uo) is det.
+:- pred ilasm__output_assembly_decl(assembly_decl::in, ilasm_info::in,
+		ilasm_info::out, io__state::di, io__state::uo) is det.
 
-ilasm__output_assembly_decl(version(A, B, C, D)) -->
+ilasm__output_assembly_decl(version(A, B, C, D), I, I) -->
 	io__format(".ver %d:%d:%d:%d", [i(A), i(B), i(C), i(D)]).
-ilasm__output_assembly_decl(public_key_token(Token)) -->
+ilasm__output_assembly_decl(public_key_token(Token), I, I) -->
 	io__write_string(".publickeytoken = ( "),
 	io__write_list(Token, " ", output_hexbyte),
 	io__write_string(" ) ").
-ilasm__output_assembly_decl(hash(Hash)) -->
+ilasm__output_assembly_decl(hash(Hash), I, I) -->
 	io__write_string(".hash = ( "),
 	io__write_list(Hash, " ", output_hexbyte),
 	io__write_string(" ) ").
+ilasm__output_assembly_decl(custom(CustomDecl), Info0, Info) -->
+	output_custom_decl(CustomDecl, Info0, Info).
+
+:- pred output_custom_decl(custom_decl::in, ilasm_info::in, ilasm_info::out,
+		io__state::di, io__state::uo) is det.
+output_custom_decl(custom_decl(Type, MaybeOwner, StringOrBytes), 
+		Info0, Info) -->
+	io__write_string(".custom "),
+
+	( { MaybeOwner = yes(Owner) } ->
+		io__write_string(" ("),
+		output_custom_type(Owner, Info0, Info1),
+		io__write_string(") ")
+	;
+		{ Info1 = Info0 }
+	),
+	output_custom_type(Type, Info1, Info),
+	( { StringOrBytes = bytes(Bytes) } ->
+		io__write_string(" = ("),
+		io__write_list(Bytes, " ", output_hexbyte),
+		io__write_string(")")
+	;
+		[]
+	),
+	io__write_string("\n").
+
+:- pred output_custom_type(custom_type::in, ilasm_info::in, ilasm_info::out,
+		io__state::di, io__state::uo) is det.
+output_custom_type(type(Type), Info0, Info) -->
+	output_type(Type, Info0, Info).
+output_custom_type(methodref(MethodRef), Info0, Info) -->
+	output_methodref(MethodRef, Info0, Info).
+
 
 :- pred output_index(index::in, io__state::di, io__state::uo) is det.
 output_index(Index) -->
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.99
diff -u -r1.99 ml_code_gen.m
--- compiler/ml_code_gen.m	2001/08/23 09:28:02	1.99
+++ compiler/ml_code_gen.m	2001/08/24 15:09:43
@@ -1118,8 +1118,15 @@
 			Context),
 		FunctionBody = defined_here(MLDS_Statement)
 	),
+
+	pred_info_get_attributes(PredInfo, Attributes),
+	attributes_to_attribute_list(Attributes, AttributeList),
+
+	MLDSAttributes = attributes_to_mlds_attributes(ModuleInfo,
+		AttributeList),
+	
 	MLDS_ProcDefnBody = mlds__function(yes(proc(PredId, ProcId)),
-			MLDS_Params, FunctionBody).
+			MLDS_Params, FunctionBody, MLDSAttributes).
 
 	% for model_det and model_semi procedures,
 	% figure out which output variables are returned by
@@ -3266,6 +3273,22 @@
 			{ error("model_non disj in model_det disjunction") }
 		)
 	).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for handling attributes
+%
+
+:- func attributes_to_mlds_attributes(module_info, list(hlds_pred__attribute))
+		= list(mlds__attribute).
+attributes_to_mlds_attributes(ModuleInfo, Attrs) =
+	list__map(attribute_to_mlds_attribute(ModuleInfo), Attrs).
+
+:- func attribute_to_mlds_attribute(module_info, hlds_pred__attribute)
+	= mlds__attribute.
+attribute_to_mlds_attribute(ModuleInfo, custom(Type)) = 
+	custom(mercury_type_to_mlds_type(ModuleInfo, Type)).
+
 
 :- func this_file = string.
 this_file = "mlds_to_c.m".
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.43
diff -u -r1.43 ml_code_util.m
--- compiler/ml_code_util.m	2001/07/13 08:04:41	1.43
+++ compiler/ml_code_util.m	2001/08/24 15:09:43
@@ -921,8 +921,9 @@
 	%
 	{ DeclFlags = ml_gen_label_func_decl_flags },
 	{ MaybePredProcId = no },
-	{ FuncDefn = function(MaybePredProcId, FuncParams,
-		defined_here(Statement)) },
+	{ Attributes = [] },
+	{ FuncDefn = function(MaybePredProcId, FuncParams, 
+		defined_here(Statement), Attributes) },
 	{ Func = mlds__defn(FuncName, mlds__make_context(Context), DeclFlags,
 			FuncDefn) }.
 
@@ -1775,14 +1776,14 @@
 
 	{ 
 		Defn = mlds__defn(function(PredLabel, ProcId, 
-			yes(SeqNum), _), _, _, function(_, _, defined_here(_)))
+			yes(SeqNum), _), _, _, function(_, _,
+			defined_here(_), _))
 	->
 		% We call the proxy function.
 		QualProcLabel = qual(MLDS_Module, PredLabel - ProcId),
 		ProxyFuncRval = const(code_addr_const(
 			internal(QualProcLabel, SeqNum, ProxySignature))),
 
-	
 		% Put it inside a block where we call it.
 		MLDS_Stmt = call(ProxySignature, ProxyFuncRval, ObjectRval,
 			ProxyArgRvals, RetLvals, CallOrTailcall),
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.41
diff -u -r1.41 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2001/08/13 02:12:23	1.41
+++ compiler/ml_elim_nested.m	2001/08/24 15:09:44
@@ -162,7 +162,7 @@
 ml_elim_nested_defns(ModuleName, Globals, OuterVars, Defn0) = FlatDefns :-
 	Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
 	( DefnBody0 = mlds__function(PredProcId, Params,
-			defined_here(FuncBody0)) ->
+			defined_here(FuncBody0), Attributes) ->
 		EnvName = ml_env_name(Name),
 			% XXX this should be optimized to generate 
 			% EnvTypeName from just EnvName
@@ -272,9 +272,8 @@
 				HoistedDefns = HoistedDefns0
 			)
 		),
-
 		DefnBody = mlds__function(PredProcId, Params,
-			defined_here(FuncBody)),
+			defined_here(FuncBody), Attributes),
 		Defn = mlds__defn(Name, Context, Flags, DefnBody),
 		FlatDefns = list__append(HoistedDefns, [Defn])
 	;
@@ -495,8 +494,8 @@
 ml_insert_init_env(TypeName, ModuleName, Globals, Defn0, Defn, Init0, Init) :-
 	Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
 	(
-		DefnBody0 = mlds__function(PredProcId, Params, 
-			defined_here(FuncBody0)),
+		DefnBody0 = mlds__function(PredProcId, Params,
+			defined_here(FuncBody0), Attributes),
 		statement_contains_var(FuncBody0, qual(ModuleName,
 			mlds__var_name("env_ptr", no)))
 	->
@@ -515,7 +514,7 @@
 		FuncBody = mlds__statement(block([EnvPtrDecl],
 				[InitEnvPtr, FuncBody0]), Context),
 		DefnBody = mlds__function(PredProcId, Params,
-			defined_here(FuncBody)),
+			defined_here(FuncBody), Attributes),
 		Defn = mlds__defn(Name, Context, Flags, DefnBody),
 		Init = yes
 	;
@@ -832,7 +831,8 @@
 flatten_nested_defn(Defn0, FollowingDefns, FollowingStatements, Defns) -->
 	{ Defn0 = mlds__defn(Name, Context, Flags0, DefnBody0) },
 	(
-		{ DefnBody0 = mlds__function(PredProcId, Params, FuncBody0) },
+		{ DefnBody0 = mlds__function(PredProcId, Params, FuncBody0,
+			Attributes) },
 		%
 		% recursively flatten the nested function
 		%
@@ -846,7 +846,8 @@
 		{ Flags1 = set_access(Flags0, private) },
 		{ Flags = set_per_instance(Flags1, one_copy) },
 
-		{ DefnBody = mlds__function(PredProcId, Params, FuncBody) },
+		{ DefnBody = mlds__function(PredProcId, Params, FuncBody,
+			Attributes) },
 		{ Defn = mlds__defn(Name, Context, Flags, DefnBody) },
 
 		% Note that we assume that we can safely hoist stuff
@@ -945,7 +946,7 @@
 	),
 	(
 		FollowingDefn = mlds__defn(_, _, _,
-			mlds__function(_, _, _)),
+			mlds__function(_, _, _, _)),
 		defn_contains_var(FollowingDefn, QualVarName)
 	;
 		FollowingDefn = mlds__defn(_, _, _,
@@ -1257,8 +1258,8 @@
 :- mode defn_body_contains_defn(in, out) is nondet.
 
 % defn_body_contains_defn(mlds__data(_Type, _Initializer), _Defn) :- fail.
-defn_body_contains_defn(mlds__function(_PredProcId, _Params, FunctionBody),
-		Name) :-
+defn_body_contains_defn(mlds__function(_PredProcId, _Params, FunctionBody,
+		_Attrs), Name) :-
 	function_body_contains_defn(FunctionBody, Name).
 defn_body_contains_defn(mlds__class(ClassDefn), Name) :-
 	ClassDefn = mlds__class_defn(_Kind, _Imports, _Inherits, _Implements,
@@ -1394,8 +1395,8 @@
 
 defn_body_contains_var(mlds__data(_Type, Initializer), Name) :-
 	initializer_contains_var(Initializer, Name).
-defn_body_contains_var(mlds__function(_PredProcId, _Params, FunctionBody),
-		Name) :-
+defn_body_contains_var(mlds__function(_PredProcId, _Params, FunctionBody,
+		_Attrs), Name) :-
 	function_body_contains_var(FunctionBody, Name).
 defn_body_contains_var(mlds__class(ClassDefn), Name) :-
 	ClassDefn = mlds__class_defn(_Kind, _Imports, _Inherits, _Implements,
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.12
diff -u -r1.12 ml_optimize.m
--- compiler/ml_optimize.m	2001/07/12 15:44:53	1.12
+++ compiler/ml_optimize.m	2001/08/24 15:09:44
@@ -74,13 +74,15 @@
 optimize_in_defn(ModuleName, Globals, Defn0) = Defn :-
 	Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
 	(
-		DefnBody0 = mlds__function(PredProcId, Params, FuncBody0),
+		DefnBody0 = mlds__function(PredProcId, Params, FuncBody0,
+			Attributes),
 		OptInfo = opt_info(Globals, ModuleName, Name, Params, Context),
 
 		FuncBody1 = optimize_func(OptInfo, FuncBody0),
 		FuncBody = optimize_in_function_body(OptInfo, FuncBody1),
 
-		DefnBody = mlds__function(PredProcId, Params, FuncBody),
+		DefnBody = mlds__function(PredProcId, Params, FuncBody,
+			Attributes),
 		Defn = mlds__defn(Name, Context, Flags, DefnBody)
 	;
 		DefnBody0 = mlds__data(_, _),
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.10
diff -u -r1.10 ml_tailcall.m
--- compiler/ml_tailcall.m	2001/07/12 15:44:53	1.10
+++ compiler/ml_tailcall.m	2001/08/24 15:09:44
@@ -113,7 +113,8 @@
 mark_tailcalls_in_defn(Defn0) = Defn :-
 	Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
 	(
-		DefnBody0 = mlds__function(PredProcId, Params, FuncBody0),
+		DefnBody0 = mlds__function(PredProcId, Params, FuncBody0,
+			Attributes),
 		%
 		% Compute the initial value of the `Locals' and
 		% `AtTail' arguments.
@@ -127,7 +128,8 @@
 		),
 		FuncBody = mark_tailcalls_in_function_body(FuncBody0,
 			AtTail, Locals),
-		DefnBody = mlds__function(PredProcId, Params, FuncBody),
+		DefnBody = mlds__function(PredProcId, Params, FuncBody,
+			Attributes),
 		Defn = mlds__defn(Name, Context, Flags, DefnBody)
 	;
 		DefnBody0 = mlds__data(_, _),
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.12
diff -u -r1.12 ml_type_gen.m
--- compiler/ml_type_gen.m	2001/08/14 18:41:18	1.12
+++ compiler/ml_type_gen.m	2001/08/24 15:09:44
@@ -556,9 +556,10 @@
 	),
 	
 	Stmt = mlds__statement(block([], InitMembers), Context),
+	Attributes = [],
 
 	Ctor = mlds__function(no, func_params(Args, ReturnValues),
-			defined_here(Stmt)),
+			defined_here(Stmt), Attributes),
 	CtorFlags = init_decl_flags(public, per_instance, non_virtual,
 			overridable, modifiable, concrete),
 
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.13
diff -u -r1.13 ml_util.m
--- compiler/ml_util.m	2001/07/13 10:27:44	1.13
+++ compiler/ml_util.m	2001/08/24 15:09:45
@@ -279,7 +279,7 @@
 
 defn_contains_foreign_code(NativeTargetLang, Defn) :-
 	Defn = mlds__defn(_Name, _Context, _Flags, Body),
-	Body = function(_, _, defined_here(FunctionBody)),
+	Body = function(_, _, defined_here(FunctionBody), _),
 	statement_contains_statement(FunctionBody, Statement),
 	Statement = mlds__statement(Stmt, _),
 	( 
@@ -291,7 +291,7 @@
 
 defn_contains_outline_foreign_proc(ForeignLang, Defn) :-
 	Defn = mlds__defn(_Name, _Context, _Flags, Body),
-	Body = function(_, _, defined_here(FunctionBody)),
+	Body = function(_, _, defined_here(FunctionBody), _),
 	statement_contains_statement(FunctionBody, Statement),
 	Statement = mlds__statement(Stmt, _),
 	Stmt = atomic(outline_foreign_proc(ForeignLang, _, _)).
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.69
diff -u -r1.69 mlds.m
--- compiler/mlds.m	2001/08/17 05:19:19	1.69
+++ compiler/mlds.m	2001/08/24 15:09:45
@@ -445,8 +445,8 @@
 			maybe(pred_proc_id),	% identifies the original
 						% Mercury procedure, if any
 			mlds__func_params,	% the arguments & return types
-			mlds__function_body	% the function body
-
+			mlds__function_body,	% the function body
+			list(mlds__attribute)	% attributes
 		)
 		% packages, classes, interfaces, structs, enums
 	;	mlds__class(
@@ -747,6 +747,15 @@
 		mlds__context
 	).
 
+%-----------------------------------------------------------------------------%
+%
+% Attributes
+%
+
+:- type mlds__attribute
+	---> custom(
+		mlds__type
+	).
 
 %-----------------------------------------------------------------------------%
 %
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.102
diff -u -r1.102 mlds_to_c.m
--- compiler/mlds_to_c.m	2001/08/17 13:09:43	1.102
+++ compiler/mlds_to_c.m	2001/08/24 15:09:46
@@ -812,7 +812,7 @@
 		globals__io_lookup_bool_option(highlevel_data, HighLevelData),
 		(
 			{ HighLevelData = yes },
-			{ DefnBody = mlds__function(_, Signature, _) }
+			{ DefnBody = mlds__function(_, Signature, _, _) }
 		->
 			{ Signature = mlds__func_params(Parameters,
 				_RetTypes) },
@@ -920,7 +920,7 @@
 		mlds_output_data_decl(Name, Type, initializer_array_size(Initializer))
 	;
 		{ DefnBody = mlds__function(MaybePredProcId, Signature,
-			_MaybeBody) },
+			_MaybeBody, _Attrs) },
 		mlds_output_maybe(MaybePredProcId, mlds_output_pred_proc_id),
 		mlds_output_func_decl(Indent, Name, Context, Signature)
 	;
@@ -939,7 +939,7 @@
 		mlds_output_data_defn(Name, Type, Initializer)
 	;
 		{ DefnBody = mlds__function(MaybePredProcId, Signature,
-			MaybeBody) },
+			MaybeBody, _Attributes) },
 		mlds_output_maybe(MaybePredProcId, mlds_output_pred_proc_id),
 		mlds_output_func(Indent, Name, Context, Signature, MaybeBody)
 	;
@@ -1856,7 +1856,7 @@
 		{ Name \= type(_, _) },
 		% Don't output "static" for functions that don't have a body.
 		% This can happen for Mercury procedures declared `:- external'
-		{ DefnBody \= mlds__function(_, _, external) }
+		{ DefnBody \= mlds__function(_, _, external, _) }
 	->
 		io__write_string("static ")
 	;
Index: compiler/mlds_to_csharp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_csharp.m,v
retrieving revision 1.15
diff -u -r1.15 mlds_to_csharp.m
--- compiler/mlds_to_csharp.m	2001/08/13 01:39:31	1.15
+++ compiler/mlds_to_csharp.m	2001/08/24 15:09:47
@@ -204,7 +204,9 @@
 	_Context, _DeclFlags, Entity)) -->
 
 	( 
-		{ Entity = mlds__function(_, Params, defined_here(Statement)) },
+			% XXX we ignore the attributes
+		{ Entity = mlds__function(_, Params, defined_here(Statement),
+			_Attributes) },
 		{ has_foreign_languages(Statement, Langs) },
 		{ list__member(csharp, Langs) }
 	->
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.50
diff -u -r1.50 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m	2001/08/03 12:07:26	1.50
+++ compiler/mlds_to_gcc.m	2001/08/24 15:09:48
@@ -791,7 +791,7 @@
 		{ GlobalInfo = GlobalInfo0 ^ global_vars := GlobalVars }
 	;
 		{ DefnBody = mlds__function(_MaybePredProcId, Signature,
-			FunctionBody) },
+			FunctionBody, _Attributes) },
 		gen_func(Name, Context, Flags, Signature, FunctionBody,
 			GlobalInfo0, GlobalInfo)
 	;
@@ -811,7 +811,7 @@
 		build_local_data_defn(Name, Flags, Type,
 			Initializer, DefnInfo, GCC_Defn)
 	;
-		{ DefnBody = mlds__function(_, _, _) },
+		{ DefnBody = mlds__function(_, _, _, _) },
 		% nested functions should get eliminated by ml_elim_nested,
 		% unless --gcc-nested-functions is enabled.
 		% XXX --gcc-nested-functions is not yet implemented
@@ -838,7 +838,7 @@
 			GCC_Defn),
 		add_field_decl_flags(Flags, GCC_Defn)
 	;
-		{ DefnBody = mlds__function(_, _, _) },
+		{ DefnBody = mlds__function(_, _, _, _) },
 		{ unexpected(this_file, "function nested in type") }
 	;
 		{ DefnBody = mlds__class(_) },
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.79
diff -u -r1.79 mlds_to_il.m
--- compiler/mlds_to_il.m	2001/08/24 12:36:43	1.79
+++ compiler/mlds_to_il.m	2001/08/24 15:09:49
@@ -289,7 +289,7 @@
 	list__map(mlds_export_to_mlds_defn, AllExports, ExportDefns),
 
 	list__filter((pred(D::in) is semidet :-
-			( D = mlds__defn(_, _, _, mlds__function(_, _, _))
+			( D = mlds__defn(_, _, _, mlds__function(_, _, _, _))
 			; D = mlds__defn(_, _, _, mlds__data(_, _))
 			)
 		), MLDS0 ^ defns ++ ExportDefns, MercuryCodeMembers, Others),
@@ -317,13 +317,15 @@
 	= defn(Name, Context, Flags, Entity) :-
 	( Entity0 = data(Type, Initializer),
 		Entity = data(Type, rename_initializer(Initializer))
-	; Entity0 = function(MaybePredProcId, Params, FunctionBody0),
+	; Entity0 = function(MaybePredProcId, Params, FunctionBody0,
+			Attributes),
 		( FunctionBody0 = defined_here(Stmt),
 			FunctionBody = defined_here(rename_statement(Stmt))
 		; FunctionBody0 = external,
 			FunctionBody = external
 		),
-		Entity = function(MaybePredProcId, Params, FunctionBody)
+		Entity = function(MaybePredProcId, Params, FunctionBody,
+			Attributes)
 	; Entity0 = class(ClassDefn),
 		ClassDefn = class_defn(Kind, Imports, Inherits, Implements,
 				Ctors, Members),
@@ -501,7 +503,7 @@
 		_Decl, Info, Info) :-
 	sorry(this_file, "top level data definition!").
 mlds_defn_to_ilasm_decl(defn(_Name, _Context, _Flags,
-		function(_MaybePredProcId, _Params, _MaybeStmts)),
+		function(_MaybePredProcId, _Params, _MaybeStmts, _Attrs)),
 		_Decl, Info, Info) :-
 	sorry(this_file, "top level function definition!").
 mlds_defn_to_ilasm_decl(defn(Name, Context, Flags0, class(ClassDefn)),
@@ -587,8 +589,9 @@
 		% Generate an empty block for the body of the constructor.
 		Stmt = mlds__statement(block([], []), Context),
 
+		Attributes = [],
 		Ctor = mlds__function(no, func_params([], []),
-				defined_here(Stmt)),
+				defined_here(Stmt), Attributes),
 		CtorFlags = init_decl_flags(public, per_instance, non_virtual,
 				overridable, modifiable, concrete),
 
@@ -886,7 +889,8 @@
 			MaybeOffset, Initializer) }.
 
 generate_method(_, IsCons, defn(Name, Context, Flags, Entity), ClassMember) -->
-	{ Entity = function(_MaybePredProcId, Params, MaybeStatement) },
+	{ Entity = function(_MaybePredProcId, Params, MaybeStatement,
+		Attributes) },
 
 	il_info_get_module_name(ModuleName),
 
@@ -1058,7 +1062,10 @@
 	VerifiableCode =^ verifiable_code,
 	{ MethodBody = make_method_defn(DebugIlAsm, VerifiableCode,
 		InstrsTree) },
-	{ list__append(EntryPoint, MethodBody, MethodContents) },
+	{ CustomAttributes = attributes_to_custom_attributes(DataRep,
+		Attributes) },
+	{ list__condense([EntryPoint, CustomAttributes, MethodBody],
+		MethodContents) },
 
 	{ ClassMember = ilasm__method(methodhead(Attrs, MemberName,
 			ILSignature, []), MethodContents)}.
@@ -1072,6 +1079,20 @@
 
 %-----------------------------------------------------------------------------%
 
+:- func attributes_to_custom_attributes(il_data_rep, list(mlds__attribute))
+		= list(method_body_decl).
+attributes_to_custom_attributes(DataRep, Attrs) = 
+	list__map(attribute_to_custom_attribute(DataRep), Attrs).
+
+:- func attribute_to_custom_attribute(il_data_rep, mlds__attribute)
+		= method_body_decl.
+attribute_to_custom_attribute(DataRep, custom(MLDSType)) = custom(CustomDecl) :-
+	ClassName = mlds_type_to_ilds_class_name(DataRep, MLDSType),
+	MethodRef = get_constructor_methoddef(ClassName, []),
+	CustomDecl = custom_decl(methodref(MethodRef), no, no_initalizer).
+
+%-----------------------------------------------------------------------------%
+
 :- func mangle_dataname(mlds__data_name) = string.
 
 mangle_dataname(var(MLDSVarName))
@@ -1163,8 +1184,10 @@
 			[CallStatement, ReturnStatement]
 		)
 		), Context),
-		
-	DefnEntity = function(no, Params, defined_here(Statement)),
+	
+	Attributes = [],
+	DefnEntity = function(no, Params, defined_here(Statement),
+		Attributes),
 
 	Flags = init_decl_flags(public, one_copy, non_virtual, overridable,
 		const, concrete),
@@ -2595,8 +2618,8 @@
 
 :- pred make_class_constructor_class_member(fieldref, mlds__imports,
 	list(instr), list(instr), class_member, il_info, il_info).
-:- mode make_class_constructor_class_member(in, in, in, in, out,
-		in, out) is det.
+:- mode make_class_constructor_class_member(in, in, in, in,
+	out, in, out) is det.
 make_class_constructor_class_member(DoneFieldRef, Imports, AllocInstrs, 
 		InitInstrs, Method) -->
 	{ Method = method(methodhead([public, static], cctor, 
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.12
diff -u -r1.12 mlds_to_java.m
--- compiler/mlds_to_java.m	2001/08/05 06:17:02	1.12
+++ compiler/mlds_to_java.m	2001/08/24 15:09:50
@@ -422,7 +422,7 @@
 	(
 		Name0 = function(_Label0, ProcID, MaybeSeqNum, PredID),
 		Body0 = mlds__function(MaybeID, Params0, 
-			MaybeStatements0),
+			MaybeStatements0, Attributes),
 		MaybeStatements0 = defined_here(Statements0),
 		Statements0 = mlds__statement(
 			block(BlockDefns0, _BlockList0), _) 
@@ -460,7 +460,7 @@
 		%
 		Params = mlds__func_params(Args, RetTypes),
 		Body   = mlds__function(MaybeID, Params,
-			defined_here(Statements)),
+			defined_here(Statements), Attributes),
 		Flags  = ml_gen_special_member_decl_flags,	
 		Defn   = mlds__defn(Name, Context, Flags, Body) 
 	;
@@ -629,7 +629,8 @@
 output_defn_body(_, Name, _, mlds__data(Type, Initializer)) -->
 	output_data_defn(Name, Type, Initializer).
 output_defn_body(Indent, Name, Context, 
-		mlds__function(MaybePredProcId, Signature, MaybeBody)) -->
+		mlds__function(MaybePredProcId, Signature, MaybeBody,
+			_Attributes)) -->
 	output_maybe(MaybePredProcId, output_pred_proc_id),
 	output_func(Indent, Name, Context, Signature, MaybeBody).
 output_defn_body(Indent, Name, Context, mlds__class(ClassDefn)) -->
Index: compiler/mlds_to_mcpp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_mcpp.m,v
retrieving revision 1.18
diff -u -r1.18 mlds_to_mcpp.m
--- compiler/mlds_to_mcpp.m	2001/08/13 01:39:33	1.18
+++ compiler/mlds_to_mcpp.m	2001/08/24 15:09:51
@@ -219,8 +219,9 @@
 		defn(function(PredLabel, ProcId, MaybeSeqNum, _PredId), 
 	_Context, _DeclFlags, Entity)) -->
 	( 
+			% XXX we ignore the attributes
 		{ Entity = mlds__function(_, Params,
-			defined_here(Statement)) },
+			defined_here(Statement), _) },
 		( 
 			{ has_inline_target_code_statement(Statement) }
 		;

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------