[m-dev.] diff: MLDS back-end: support tabling

Fergus Henderson fjh at cs.mu.OZ.AU
Fri Dec 31 03:59:45 AEDT 1999


Estimated hours taken: 1

Add support for `pragma memo' and `pragma loopcheck'
to the MLDS back-end.

compiler/ml_code_util.m:
	Change the interface to ml_gen_mlds_var_decl so that it takes
	an mlds__data_name rather than an mlds__var_name, so that it
	can be used to generate declarations for tabling_pointer
	variables.

compiler/ml_code_gen.m:
compiler/ml_code_util.m:
compiler/ml_unify_gen.m:
	Change calls to ml_gen_mlds_var_decl to match its new interface.

compiler/ml_code_gen.m:
	For tabled procedures, generate a definition of the
	variable which holds the table.

compiler/mlds_to_c.m:
	Add code to handling output the names of the variables
	used to hold tables.

Workspace: /home/mercury0/fjh/mercury
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.25
diff -u -d -r1.25 ml_code_gen.m
--- ml_code_gen.m	1999/12/29 08:09:11	1.25
+++ ml_code_gen.m	1999/12/30 16:34:31
@@ -754,7 +754,31 @@
 		MLDS_ProcDefnBody, ExtraDefns),
 	MLDS_ProcDefn = mlds__defn(MLDS_Name, MLDS_Context, MLDS_DeclFlags,
 				MLDS_ProcDefnBody),
-	Defns = list__append(ExtraDefns, [MLDS_ProcDefn | Defns0]).
+	Defns1 = list__append(ExtraDefns, [MLDS_ProcDefn | Defns0]),
+	ml_gen_maybe_add_table_var(ModuleInfo, PredId, ProcId, ProcInfo,
+		Defns1, Defns).
+
+:- pred ml_gen_maybe_add_table_var(module_info, pred_id, proc_id, proc_info,
+		mlds__defns, mlds__defns).
+:- mode ml_gen_maybe_add_table_var(in, in, in, in, in, out) is det.
+
+ml_gen_maybe_add_table_var(ModuleInfo, PredId, ProcId, ProcInfo,
+		Defns0, Defns) :-
+	proc_info_eval_method(ProcInfo, EvalMethod),
+	(
+		EvalMethod \= eval_normal
+	->
+		ml_gen_pred_label(ModuleInfo, PredId, ProcId,
+			MLDS_PredLabel, _MLDS_PredModule),
+		Var = tabling_pointer(MLDS_PredLabel - ProcId),
+		proc_info_context(ProcInfo, Context),
+		TablePointerVarDefn = ml_gen_mlds_var_decl(
+			Var, mlds__generic_type,
+			mlds__make_context(Context)),
+		Defns = [TablePointerVarDefn | Defns0]
+	;
+		Defns = Defns0
+	).
 
 	% Return the declaration flags appropriate for a procedure definition.
 	%
@@ -1198,7 +1222,7 @@
 	%
 :- func ml_gen_commit_var_decl(mlds__context, mlds__var_name) = mlds__defn.
 ml_gen_commit_var_decl(Context, VarName) =
-	ml_gen_mlds_var_decl(VarName, mlds__commit_type, Context).
+	ml_gen_mlds_var_decl(var(VarName), mlds__commit_type, Context).
 
 	% Generate MLDS code for the different kinds of HLDS goals.
 	%
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.1
diff -u -d -r1.1 ml_code_util.m
--- ml_code_util.m	1999/12/29 08:09:11	1.1
+++ ml_code_util.m	1999/12/30 16:23:32
@@ -187,7 +187,8 @@
 
 	% Generate a declaration for an MLDS variable, given its MLDS type.
 	%
-:- func ml_gen_mlds_var_decl(var_name, mlds__type, mlds__context) = mlds__defn.
+:- func ml_gen_mlds_var_decl(mlds__data_name, mlds__type, mlds__context) =
+	mlds__defn.
 
 %-----------------------------------------------------------------------------%
 %
@@ -867,13 +868,13 @@
 	% Generate a declaration for an MLDS variable, given its HLDS type.
 	%
 ml_gen_var_decl(VarName, Type, Context) =
-	ml_gen_mlds_var_decl(VarName, mercury_type_to_mlds_type(Type),
+	ml_gen_mlds_var_decl(var(VarName), mercury_type_to_mlds_type(Type),
 		Context).
 
 	% Generate a declaration for an MLDS variable, given its MLDS type.
 	%
-ml_gen_mlds_var_decl(VarName, MLDS_Type, Context) = MLDS_Defn :-
-	Name = data(var(VarName)),
+ml_gen_mlds_var_decl(DataName, MLDS_Type, Context) = MLDS_Defn :-
+	Name = data(DataName),
 	MaybeInitializer = no,
 	Defn = data(MLDS_Type, MaybeInitializer),
 	DeclFlags = ml_gen_var_decl_flags,
@@ -948,7 +949,7 @@
 	% Generate the declaration for the built-in `succeeded' variable.
 	%
 ml_gen_succeeded_var_decl(Context) =
-	ml_gen_mlds_var_decl("succeeded", mlds__bool_type, Context).
+	ml_gen_mlds_var_decl(var("succeeded"), mlds__bool_type, Context).
 
 	% Return the lval for the `succeeded' flag.
 	% (`succeeded' is a boolean variable used to record
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.1
diff -u -d -r1.1 ml_unify_gen.m
--- ml_unify_gen.m	1999/12/29 08:09:12	1.1
+++ ml_unify_gen.m	1999/12/30 16:13:35
@@ -544,7 +544,7 @@
 	%
 	{ ClosureName = "closure" },
 	{ ClosureArgName = "closure_arg" },
-	{ ClosureDecl = ml_gen_mlds_var_decl(ClosureName,
+	{ ClosureDecl = ml_gen_mlds_var_decl(var(ClosureName),
 		mlds__generic_env_ptr_type, MLDS_Context) },
 	ml_qualify_var(ClosureName, ClosureLval),
 	ml_qualify_var(ClosureArgName, ClosureArgLval),
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.20
diff -u -d -r1.20 mlds_to_c.m
--- mlds_to_c.m	1999/12/06 07:25:25	1.20
+++ mlds_to_c.m	1999/12/30 16:23:08
@@ -755,8 +755,9 @@
 	{ error("mlds_to_c.m: NYI: proc_layout") }.
 mlds_output_data_name(internal_layout(_ProcLabel, _FuncSeqNum)) -->
 	{ error("mlds_to_c.m: NYI: internal_layout") }.
-mlds_output_data_name(tabling_pointer(_ProcLabel)) -->
-	{ error("mlds_to_c.m: NYI: tabling_pointer") }.
+mlds_output_data_name(tabling_pointer(ProcLabel)) -->
+	io__write_string("table_for_"),
+	mlds_output_proc_label(ProcLabel).
 
 %-----------------------------------------------------------------------------%
 %

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



More information about the developers mailing list