[m-dev.] diff: move defn_is_* to ml_util.m

[Fergus Henderson]

This change is in response to one of Tyson's review comments for my
GCC back-end interface changes.  But mlds_to_c.m was affected too,
so I thought it best to commit this one as a separate change.

----------

Estimated hours taken: 0.5

compiler/mlds_to_gcc.m:
compiler/mlds_to_c.m:
compiler/ml_util.m:
	Move various MLDS utility routines from mlds_to_{c,gcc}.m to
	ml_util.m.

Workspace: /home/pgrad/fjh/ws/gcc/mercury
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.75
diff -u -d -r1.75 mlds_to_c.m
--- compiler/mlds_to_c.m	2001/01/01 04:03:33	1.75
+++ compiler/mlds_to_c.m	2001/01/11 13:23:48
@@ -150,44 +150,6 @@
 	mlds_output_init_fn_decls(MLDS_ModuleName), io__nl,
 	mlds_output_hdr_end(Indent, ModuleName).
 
-:- pred defn_is_public(mlds__defn).
-:- mode defn_is_public(in) is semidet.
-
-defn_is_public(Defn) :-
-	Defn = mlds__defn(_Name, _Context, Flags, _Body),
-	access(Flags) \= private.
-
-:- pred defn_is_type(mlds__defn).
-:- mode defn_is_type(in) is semidet.
-
-defn_is_type(Defn) :-
-	Defn = mlds__defn(Name, _Context, _Flags, _Body),
-	Name = type(_, _).
-
-:- pred defn_is_function(mlds__defn).
-:- mode defn_is_function(in) is semidet.
-
-defn_is_function(Defn) :-
-	Defn = mlds__defn(Name, _Context, _Flags, _Body),
-	Name = function(_, _, _, _).
-
-:- pred defn_is_type_ctor_info(mlds__defn).
-:- mode defn_is_type_ctor_info(in) is semidet.
-
-defn_is_type_ctor_info(Defn) :-
-	Defn = mlds__defn(_Name, _Context, _Flags, Body),
-	Body = mlds__data(Type, _),
-	Type = mlds__rtti_type(RttiName),
-	RttiName = type_ctor_info.
-
-:- pred defn_is_commit_type_var(mlds__defn).
-:- mode defn_is_commit_type_var(in) is semidet.
-
-defn_is_commit_type_var(Defn) :-
-	Defn = mlds__defn(_Name, _Context, _Flags, Body),
-	Body = mlds__data(Type, _),
-	Type = mlds__commit_type.
-
 :- pred mlds_output_hdr_imports(indent, mlds__imports, io__state, io__state).
 :- mode mlds_output_hdr_imports(in, in, di, uo) is det.
 
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.16
diff -u -d -r1.16 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m	2001/01/10 10:02:37	1.16
+++ compiler/mlds_to_gcc.m	2001/01/10 12:33:37
@@ -114,7 +114,7 @@
 	% Handle output of any foreign code (C, Ada, Fortran, etc.)
 	% to appropriate files.
 	%
-	{ list__filter(defn_contains_foreign_code, Defns0,
+	{ list__filter(defn_contains_foreign_code(lang_asm), Defns0,
 		ForeignDefns, Defns) },
 	(
 		{ ForeignCode = mlds__foreign_code([], [], []) },
@@ -3145,30 +3145,6 @@
 'MR_int_least32_t'	= gcc__int32_type_node.
 'MR_int_least64_t'	= gcc__int64_type_node.
 'MR_intptr_t'		= gcc__intptr_type_node.
-
-%-----------------------------------------------------------------------------%
-%
-% Utility predicates.
-%
-
-:- pred defn_contains_foreign_code(mlds__defn).
-:- mode defn_contains_foreign_code(in) is semidet.
-
-defn_contains_foreign_code(Defn) :-
-	Defn = mlds__defn(_Name, _Context, _Flags, Body),
-	Body = function(_, _, yes(FunctionBody)),
-	statement_contains_statement(FunctionBody, Statement),
-	Statement = mlds__statement(Stmt, _),
-	Stmt = atomic(target_code(TargetLang, _)),
-	TargetLang \= lang_asm.
-
-	% XXX This should be moved to ml_util.m
-:- pred defn_is_type(mlds__defn).
-:- mode defn_is_type(in) is semidet.
-
-defn_is_type(Defn) :-
-	Defn = mlds__defn(Name, _Context, _Flags, _Body),
-	Name = type(_, _).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.3
diff -u -d -r1.3 ml_util.m
--- compiler/ml_util.m	2000/11/21 13:37:44	1.3
+++ compiler/ml_util.m	2001/01/11 13:30:52
@@ -38,10 +38,41 @@
 :- pred stmt_contains_statement(mlds__stmt, mlds__statement).
 :- mode stmt_contains_statement(in, out) is nondet.
 
+	% defn_contains_foreign_code(NativeTargetLang, Defn):
+	%	Succeeds iff this definition contains target_code
+	%	statements in a target language other than the
+	%	specified native target language.
+:- pred defn_contains_foreign_code(target_lang, mlds__defn).
+:- mode defn_contains_foreign_code(in, in) is semidet.
+
+	% Succeeds iff this definition is a type definition.
+:- pred defn_is_type(mlds__defn).
+:- mode defn_is_type(in) is semidet.
+
+	% Succeeds iff this definition is a function definition.
+:- pred defn_is_function(mlds__defn).
+:- mode defn_is_function(in) is semidet.
+
+	% Succeeds iff this definition is a data definition which
+	% defines a type_ctor_info constant.
+:- pred defn_is_type_ctor_info(mlds__defn).
+:- mode defn_is_type_ctor_info(in) is semidet.
+
+	% Succeeds iff this definition is a data definition which
+	% defines a variable whose type is mlds__commit_type.
+:- pred defn_is_commit_type_var(mlds__defn).
+:- mode defn_is_commit_type_var(in) is semidet.
+
+	% Succeeds iff this definition has `public' in the access
+	% field in its decl_flags.
+:- pred defn_is_public(mlds__defn).
+:- mode defn_is_public(in) is semidet.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
+:- import_module rtti.
 :- import_module bool, list, std_util.
 
 can_optimize_tailcall(Name, Call) :-
@@ -78,13 +109,14 @@
 	%
 	MaybeObject = no.
 
-
+%-----------------------------------------------------------------------------%
 
 statements_contains_statement(Statements, SubStatement) :-
 	list__member(Statement, Statements),
 	statement_contains_statement(Statement, SubStatement).
 
-:- pred maybe_statement_contains_statement(maybe(mlds__statement), mlds__statement).
+:- pred maybe_statement_contains_statement(maybe(mlds__statement),
+		mlds__statement).
 :- mode maybe_statement_contains_statement(in, out) is nondet.
 
 maybe_statement_contains_statement(no, _Statement) :- fail.
@@ -158,5 +190,43 @@
 default_contains_statement(default_is_unreachable, _) :- fail.
 default_contains_statement(default_case(Statement), SubStatement) :-
 	statement_contains_statement(Statement, SubStatement).
+
+%-----------------------------------------------------------------------------%
+
+defn_contains_foreign_code(NativeTargetLang, Defn) :-
+	Defn = mlds__defn(_Name, _Context, _Flags, Body),
+	Body = function(_, _, yes(FunctionBody)),
+	statement_contains_statement(FunctionBody, Statement),
+	Statement = mlds__statement(Stmt, _),
+	Stmt = atomic(target_code(TargetLang, _)),
+	TargetLang \= NativeTargetLang.
+
+defn_is_type(Defn) :-
+	Defn = mlds__defn(Name, _Context, _Flags, _Body),
+	Name = type(_, _).
+
+defn_is_function(Defn) :-
+	Defn = mlds__defn(Name, _Context, _Flags, _Body),
+	Name = function(_, _, _, _).
+
+defn_is_type_ctor_info(Defn) :-
+	Defn = mlds__defn(_Name, _Context, _Flags, Body),
+	Body = mlds__data(Type, _),
+	Type = mlds__rtti_type(RttiName),
+	RttiName = type_ctor_info.
+
+defn_is_commit_type_var(Defn) :-
+	Defn = mlds__defn(_Name, _Context, _Flags, Body),
+	Body = mlds__data(Type, _),
+	Type = mlds__commit_type.
+
+defn_is_public(Defn) :-
+	Defn = mlds__defn(_Name, _Context, Flags, _Body),
+	access(Flags) \= private.
+
+%-----------------------------------------------------------------------------%
+ 
+:- func this_file = string.
+this_file = "mlds_to_gcc.m".
 
 %-----------------------------------------------------------------------------%

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------