[m-dev.] diff: fix MLDS inlining of pragma c_code

[Fergus Henderson]

Estimated hours taken: 1

Get the MLDS back-end to inline `pragma c_code' properly.

compiler/ml_elim_nested.m:
	Handle `target_code' instructions properly.

compiler/inlining.m:
	Re-enable inlining of `pragma_foreign_code' instructions,
	since it now works.

Workspace: /home/pgrad/fjh/ws/hg3
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.91
diff -u -d -r1.91 inlining.m
--- compiler/inlining.m	2000/10/13 13:55:27	1.91
+++ compiler/inlining.m	2000/11/18 16:48:23
@@ -827,19 +827,6 @@
 		proc_info_interface_code_model(ProcInfo, model_non)
 	),
 
-	% For the MLDS back-end, don't inline any pragma c codes.
-	% XXX This is a work-around needed because of some problems
-	% with the current MLDS back-end implementation of
-	% pragma c_code.  In particular, ml_elim_nested.m assumes
-	% that target_code instructions don't contain variables,
-	% but with the current implementation sometimes they do.
-	% Also ml_code_gen.m doesn't handle complicated pragma_c_code
-	% goals, which can result from inlining.
-	\+ (
-		HighLevelCode = yes,
-		CalledGoal = pragma_foreign_code(_,_,_,_,_,_,_,_) - _
-	),
-
 	% Don't inline memoed Aditi predicates.
 	pred_info_get_markers(PredInfo, CalledPredMarkers),
 	\+ check_marker(CalledPredMarkers, aditi_memo),
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.16
diff -u -d -r1.16 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2000/11/08 07:23:10	1.16
+++ compiler/ml_elim_nested.m	2000/11/18 08:37:54
@@ -1412,7 +1412,9 @@
 	rval_contains_var(Rval, Name).
 atomic_stmt_contains_var(trail_op(TrailOp), Name) :-
 	trail_op_contains_var(TrailOp, Name).
-atomic_stmt_contains_var(target_code(_Lang, _String), _) :- fail.
+atomic_stmt_contains_var(target_code(_Lang, Components), Name) :-
+	list__member(Component, Components),
+	target_code_component_contains_var(Component, Name).
 
 :- pred trail_op_contains_var(trail_op, mlds__var).
 :- mode trail_op_contains_var(in, in) is semidet.
@@ -1427,6 +1429,27 @@
 	lval_contains_var(Lval, Name).
 trail_op_contains_var(prune_tickets_to(Rval), Name) :-
 	rval_contains_var(Rval, Name).
+
+:- pred target_code_component_contains_var(target_code_component, mlds__var).
+:- mode target_code_component_contains_var(in, in) is semidet.
+
+target_code_component_contains_var(raw_target_code(_Code), _Name) :-
+	fail.
+target_code_component_contains_var(user_target_code(_Code, _Context), _Name) :- 
+	fail.
+target_code_component_contains_var(target_code_input(Rval), Name) :-
+	rval_contains_var(Rval, Name).
+target_code_component_contains_var(target_code_output(Lval), Name) :-
+	lval_contains_var(Lval, Name).
+target_code_component_contains_var(name(EntityName), _VarName) :-
+	EntityName = data(var(_UnqualVarName)),
+	% XXX They might match.  But the EntityName here is unqualified,
+	%     so we can't tell for sure if there is a match.  Hence we
+	%     just abort.  Currently name/1 is only used for procedure
+	%     names, not var names, so this case won't occur.  (If it
+	%     does, the right fix is probably to make the EntityName
+	%     a fully qualified name rather than an unqualified name.)
+	error("target_code_component_contains_var: name/1 used for var").
 
 :- pred rvals_contains_var(list(mlds__rval), mlds__var).
 :- mode rvals_contains_var(in, in) is semidet.

-- 
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
--------------------------------------------------------------------------