[m-dev.] diff: MLDS backend: implement commits

Fergus Henderson fjh at cs.mu.OZ.AU
Sat Nov 6 08:17:57 AEDT 1999


With these changes, tests/benchmarks/queens.m now works
with the --high-level-C backend.

----------

Estimated hours taken: 8

Add preliminary support for commits to the MLDS back-end.
Currently this only works with GNU C.

compiler/ml_code_gen.m:
	Add comments and code for implementing commits.
	
compiler/mlds.m:
	Add two new instructions, try_commit and do_commit.

compiler/mlds_to_c.m:
	Handle the new instructions (currently we assume GNU C).
	Also fix a bug where we were outputting function definitions
	without the curly braces.

Workspace: /d-drive/home/hg/fjh/mercury
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.10
diff -u -d -r1.10 ml_code_gen.m
--- compiler/ml_code_gen.m	1999/10/25 03:49:18	1.10
+++ compiler/ml_code_gen.m	1999/11/05 21:09:23
@@ -114,6 +114,35 @@
 % Code for commits
 %
 
+% There's several different ways of handling commits:
+%	- using catch/throw
+%	- using setjmp/longjmp
+%	- exiting nested functions via gotos to
+%	  their containing functions
+% The MLDS data structure abstracts away these differences
+% using the `try_commit' and `do_commit' instructions.
+% The comments below show the MLDS try_commit/do_commit version first,
+% but for clarity I've also included sample code using each of the three
+% different techniques.
+
+%	model_non in semi context: (using try_commit/do_commit)
+%		<succeeded = Goal>
+% 	===>
+%		bool succeeded;
+%		MR_COMMIT_TYPE ref;
+%		void success() {
+%			succeeded = TRUE;
+%			MR_DO_COMMIT(ref);
+%		}
+%		MR_TRY_COMMIT(ref, {
+%			<Goal && success()>
+%			succeeded = FALSE;
+%		}, {
+%			succeeded = TRUE;
+%		})
+%
+%	done:
+
 %	model_non in semi context: (using catch/throw)
 %		<succeeded = Goal>
 % 	===>
@@ -143,6 +172,51 @@
 %			succeeded = FALSE;
 %		}
 
+%	model_non in semi context: (using GNU C nested functions,
+%				GNU C local labels, and exiting
+%				the nested function by a goto
+%				to a lable in the containing function)
+%		<succeeded = Goal>
+% 	===>
+%		bool succeeded;
+%		__label__ commit;
+%		void success() {
+%			goto commit;
+%		}
+%		<Goal && success()>
+%		succeeded = FALSE;
+%		goto commit_done;
+%	commit:
+%		succeeded = TRUE;
+%	commit_done:
+%		;
+
+%	model_non in det context: (using try_commit/do_commit)
+%		<do Goal>
+%	===>
+%		MR_COMMIT_TYPE ref;
+%		void success() {
+%			MR_DO_COMMIT(ref);
+%		}
+%		MR_TRY_COMMIT(ref, {
+%			<Goal && success()>
+%		}, {})
+
+%	model_non in det context (using GNU C nested functions,
+%				GNU C local labels, and exiting
+%				the nested function by a goto
+%				to a lable in the containing function)
+%		<do Goal>
+%	===>
+%		__label__ done;
+%		void success() {
+%			goto done;
+%		}
+%		try {
+%			<Goal && success()>
+%		} catch (COMMIT) {}
+%	done:	;
+
 %	model_non in det context (using catch/throw):
 %		<do Goal>
 %	===>
@@ -788,6 +862,17 @@
 	DeclFlags = ml_gen_var_decl_flags,
 	MLDS_Defn = mlds__defn(Name, Context, DeclFlags, Defn).
 
+	% Generate the declaration for the `commit' variable.
+	%
+:- func ml_gen_commit_var_decl(mlds__context, mlds__var_name) = mlds__defn.
+ml_gen_commit_var_decl(Context, VarName) = MLDS_Defn :-
+	Name = data(var(VarName)),
+	Type = mlds__commit_type,
+	MaybeInitializer = no,
+	Defn = data(Type, MaybeInitializer),
+	DeclFlags = ml_gen_var_decl_flags,
+	MLDS_Defn = mlds__defn(Name, Context, DeclFlags, Defn).
+
 	% Generate the code for a procedure body.
 	%
 :- pred ml_gen_proc_body(code_model, hlds_goal, mlds__defns, mlds__statements,
@@ -987,11 +1072,106 @@
 :- pred ml_gen_commit(hlds_goal, code_model, prog_context,
 			mlds__defns, mlds__statements,
 			ml_gen_info, ml_gen_info).
-:- mode ml_gen_commit(in, in, in, out, out, in, out) is erroneous.
+:- mode ml_gen_commit(in, in, in, out, out, in, out) is det.
 
-ml_gen_commit(_Goal, _CodeModel, _Context, _MLDS_Decls, _MLDS_Statements) -->
-	% XXX not yet implemented
-	{ sorry("commit") }.
+ml_gen_commit(Goal, CodeModel, Context, MLDS_Decls, MLDS_Statements) -->
+	{ Goal = _ - GoalInfo },
+	{ goal_info_get_code_model(GoalInfo, GoalCodeModel) },
+
+	( { GoalCodeModel = model_non, CodeModel = model_semi } ->
+
+		%	model_non in semi context: (using try_commit/do_commit)
+		%		<succeeded = Goal>
+		% 	===>
+		%		bool succeeded;
+		%		MR_COMMIT_TYPE ref;
+		%		void success() {
+		%			succeeded = TRUE;
+		%			MR_DO_COMMIT(ref);
+		%		}
+		%		MR_TRY_COMMIT(info, {
+		%			<Goal && success()>
+		%			succeeded = FALSE;
+		%		}, {
+		%			succeeded = TRUE;
+		%		})
+
+		% generate the `success()' function
+		ml_gen_new_func_label(SuccessFuncLabel, SuccessFuncLabelRval),
+		/* push nesting level */
+		{ MLDS_Context = mlds__make_context(Context) },
+		ml_gen_info_new_commit_label(CommitLabelNum),
+		{ string__format("commit_%d", [i(CommitLabelNum)], CommitRef) },
+		ml_commit_var(CommitRef, CommitRefVar),
+		{ CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context,
+			CommitRef) },
+		{ DoCommitStmt = do_commit(CommitRefVar) },
+		{ DoCommitStatement = mlds__statement(DoCommitStmt,
+			MLDS_Context) },
+		/* pop nesting level */
+		ml_gen_label_func(SuccessFuncLabel, Context, DoCommitStatement,
+			SuccessFunc),
+
+		ml_gen_info_push_success_cont(SuccessFuncLabelRval),
+		ml_gen_goal(model_non, Goal, GoalStatement),
+		ml_gen_info_pop_success_cont,
+		ml_gen_set_success(const(false), Context, SetSuccessFalse),
+		ml_gen_set_success(const(true), Context, SetSuccessTrue),
+		{ TryCommitStmt = try_commit(CommitRefVar,
+			ml_gen_block([], [GoalStatement, SetSuccessFalse],
+				Context),
+			SetSuccessTrue) },
+		{ TryCommitStatement = mlds__statement(TryCommitStmt,
+			MLDS_Context) },
+
+		{ MLDS_Decls = [CommitRefDecl, SuccessFunc] },
+		{ MLDS_Statements = [TryCommitStatement] }
+
+	; { GoalCodeModel = model_non, CodeModel = model_det } ->
+
+		%	model_non in det context: (using try_commit/do_commit)
+		%		<do Goal>
+		%	===>
+		%		MR_COMMIT_TYPE ref;
+		%		void success() {
+		%			MR_DO_COMMIT(ref);
+		%		}
+		%		MR_TRY_COMMIT(ref, {
+		%			<Goal && success()>
+		%		}, {})
+
+		% generate the `success()' function
+		ml_gen_new_func_label(SuccessFuncLabel, SuccessFuncLabelRval),
+		/* push nesting level */
+		{ MLDS_Context = mlds__make_context(Context) },
+		ml_gen_info_new_commit_label(CommitLabelNum),
+		{ string__format("commit_%d", [i(CommitLabelNum)], CommitRef) },
+		ml_commit_var(CommitRef, CommitRefVar),
+		{ CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context,
+			CommitRef) },
+		{ DoCommitStmt = do_commit(CommitRefVar) },
+		{ DoCommitStatement = mlds__statement(DoCommitStmt,
+			MLDS_Context) },
+		/* pop nesting level */
+		ml_gen_label_func(SuccessFuncLabel, Context, DoCommitStatement,
+			SuccessFunc),
+
+		ml_gen_info_push_success_cont(SuccessFuncLabelRval),
+		ml_gen_goal(model_non, Goal, GoalStatement),
+		ml_gen_info_pop_success_cont,
+
+		{ TryCommitStmt = try_commit(CommitRefVar, GoalStatement,
+			ml_gen_block([], [], Context)) },
+		{ TryCommitStatement = mlds__statement(TryCommitStmt,
+			MLDS_Context) },
+
+		{ MLDS_Decls = [CommitRefDecl, SuccessFunc] },
+		{ MLDS_Statements = [TryCommitStatement] }
+	;
+		% no commit required
+		ml_gen_goal(CodeModel, Goal, MLDS_Decls, MLDS_Statements)
+	).
+
 
 	% Generate MLDS code for the different kinds of HLDS goals.
 	%
@@ -2982,6 +3162,18 @@
 	{ MLDS_Module = mercury_module_name_to_mlds(ModuleName) },
 	{ ContRval = lval(var(qual(MLDS_Module, "cont"))) }.
 
+	% Return the rval for the current function's `cont' argument.
+	% (The `cont' argument is a continuation function that
+	% will be called when a model_non goal succeeds.)
+	%
+:- pred ml_commit_var(mlds__var_name, mlds__var, ml_gen_info, ml_gen_info).
+:- mode ml_commit_var(in, out, in, out) is det.
+ml_commit_var(CommitRef, CommitVar) -->
+	=(MLDSGenInfo),
+	{ ml_gen_info_get_module_name(MLDSGenInfo, ModuleName) },
+	{ MLDS_Module = mercury_module_name_to_mlds(ModuleName) },
+	{ CommitVar = qual(MLDS_Module, CommitRef) }.
+
 	% Generate code to call the current success continuation.
 	% This is used for generating success when in a model_non context.
 	%
@@ -3298,10 +3490,10 @@
 % The `ml_gen_info' type holds information used during MLDS code generation
 % for a given procedure.
 %
-% Only the `func_sequence_num' field and the `stack(success_cont)' field
-% are mutable, the others are set when the `ml_gen_info' is created and then
-% never modified.
-%
+% Only the `func_sequence_num', `commit_sequence_num', and
+% `stack(success_cont)' fields are mutable; the others are set
+% when the `ml_gen_info' is created and then never modified.
+% 
 
 :- type ml_gen_info
 	--->	ml_gen_info(
@@ -3312,9 +3504,12 @@
 			map(prog_var, prog_type),
 			list(prog_var),			% output arguments
 			mlds__func_sequence_num,
+			commit_sequence_num,
 			stack(success_cont)
 		).
 
+:- type commit_sequence_num == int.
+
 :- func ml_gen_info_init(module_info, pred_id, proc_id) = ml_gen_info.
 
 ml_gen_info_init(ModuleInfo, PredId, ProcId) = MLDSGenInfo :-
@@ -3327,6 +3522,7 @@
 	OutputVars = select_output_vars(ModuleInfo, HeadVars, HeadModes,
 		VarTypes),
 	FuncLabelCounter = 0,
+	CommitLabelCounter = 0,
 	stack__init(SuccContStack),
 	MLDSGenInfo = ml_gen_info(
 			ModuleInfo,
@@ -3336,13 +3532,14 @@
 			VarTypes,
 			OutputVars,
 			FuncLabelCounter,
+			CommitLabelCounter,
 			SuccContStack
 		).
 
 :- pred ml_gen_info_get_module_info(ml_gen_info, module_info).
 :- mode ml_gen_info_get_module_info(in, out) is det.
 
-ml_gen_info_get_module_info(ml_gen_info(ModuleInfo, _, _, _, _, _, _, _),
+ml_gen_info_get_module_info(ml_gen_info(ModuleInfo, _, _, _, _, _, _, _, _),
 	ModuleInfo).
 
 :- pred ml_gen_info_get_module_name(ml_gen_info, mercury_module_name).
@@ -3355,37 +3552,46 @@
 :- pred ml_gen_info_get_pred_id(ml_gen_info, pred_id).
 :- mode ml_gen_info_get_pred_id(in, out) is det.
 
-ml_gen_info_get_pred_id(ml_gen_info(_, PredId, _, _, _, _, _, _), PredId).
+ml_gen_info_get_pred_id(ml_gen_info(_, PredId, _, _, _, _, _, _, _), PredId).
 
 :- pred ml_gen_info_get_proc_id(ml_gen_info, proc_id).
 :- mode ml_gen_info_get_proc_id(in, out) is det.
 
-ml_gen_info_get_proc_id(ml_gen_info(_, _, ProcId, _, _, _, _, _), ProcId).
+ml_gen_info_get_proc_id(ml_gen_info(_, _, ProcId, _, _, _, _, _, _), ProcId).
 
 :- pred ml_gen_info_get_varset(ml_gen_info, prog_varset).
 :- mode ml_gen_info_get_varset(in, out) is det.
 
-ml_gen_info_get_varset(ml_gen_info(_, _, _, VarSet, _, _, _, _), VarSet).
+ml_gen_info_get_varset(ml_gen_info(_, _, _, VarSet, _, _, _, _, _), VarSet).
 
 :- pred ml_gen_info_get_var_types(ml_gen_info, map(prog_var, prog_type)).
 :- mode ml_gen_info_get_var_types(in, out) is det.
 
-ml_gen_info_get_var_types(ml_gen_info(_, _, _, _, VarTypes, _, _, _),
+ml_gen_info_get_var_types(ml_gen_info(_, _, _, _, VarTypes, _, _, _, _),
 	VarTypes).
 
 :- pred ml_gen_info_get_output_vars(ml_gen_info, list(prog_var)).
 :- mode ml_gen_info_get_output_vars(in, out) is det.
 
-ml_gen_info_get_output_vars(ml_gen_info(_, _, _, _, _, OutputVars, _, _),
+ml_gen_info_get_output_vars(ml_gen_info(_, _, _, _, _, OutputVars, _, _, _),
 	OutputVars).
 
 :- pred ml_gen_info_new_func_label(ml_label_func, ml_gen_info, ml_gen_info).
 :- mode ml_gen_info_new_func_label(out, in, out) is det.
 
-ml_gen_info_new_func_label(Label, ml_gen_info(A, B, C, D, E, F, Label0, H),
-			    ml_gen_info(A, B, C, D, E, F, Label, H)) :-
+ml_gen_info_new_func_label(Label, ml_gen_info(A, B, C, D, E, F, Label0, H, I),
+			    ml_gen_info(A, B, C, D, E, F, Label, H, I)) :-
 	Label is Label0 + 1.
 
+:- pred ml_gen_info_new_commit_label(commit_sequence_num,
+		ml_gen_info, ml_gen_info).
+:- mode ml_gen_info_new_commit_label(out, in, out) is det.
+
+ml_gen_info_new_commit_label(CommitLabel,
+		ml_gen_info(A, B, C, D, E, F, G, CommitLabel0, I),
+		ml_gen_info(A, B, C, D, E, F, G, CommitLabel, I)) :-
+	CommitLabel is CommitLabel0 + 1.
+
 :- type success_cont == mlds__rval.
 
 /******
@@ -3394,15 +3600,15 @@
 :- mode ml_gen_info_get_success_cont_stack(in, out) is det.
 
 ml_gen_info_get_success_cont_stack(
-	ml_gen_info(_, _, _, _, _, _, _, SuccContStack), SuccContStack).
+	ml_gen_info(_, _, _, _, _, _, _, _, SuccContStack), SuccContStack).
 
 :- pred ml_gen_info_set_success_cont_stack(stack(success_cont),
 			ml_gen_info, ml_gen_info).
 :- mode ml_gen_info_set_success_cont_stack(in, in, out) is det.
 
 ml_gen_info_set_success_cont_stack(SuccContStack,
-		ml_gen_info(A, B, C, D, E, F, G, _),
-		ml_gen_info(A, B, C, D, E, F, G, SuccContStack)).
+		ml_gen_info(A, B, C, D, E, F, G, H, _),
+		ml_gen_info(A, B, C, D, E, F, G, H, SuccContStack)).
 ********/
 
 :- pred ml_gen_info_push_success_cont(success_cont,
@@ -3410,16 +3616,16 @@
 :- mode ml_gen_info_push_success_cont(in, in, out) is det.
 
 ml_gen_info_push_success_cont(SuccCont,
-		ml_gen_info(A, B, C, D, E, F, G, Stack0),
-		ml_gen_info(A, B, C, D, E, F, G, Stack)) :-
+		ml_gen_info(A, B, C, D, E, F, G, H, Stack0),
+		ml_gen_info(A, B, C, D, E, F, G, H, Stack)) :-
 	stack__push(Stack0, SuccCont, Stack).
 
 :- pred ml_gen_info_pop_success_cont(ml_gen_info, ml_gen_info).
 :- mode ml_gen_info_pop_success_cont(in, out) is det.
 
 ml_gen_info_pop_success_cont(
-		ml_gen_info(A, B, C, D, E, F, G, Stack0),
-		ml_gen_info(A, B, C, D, E, F, G, Stack)) :-
+		ml_gen_info(A, B, C, D, E, F, G, H, Stack0),
+		ml_gen_info(A, B, C, D, E, F, G, H, Stack)) :-
 	stack__pop_det(Stack0, _SuccCont, Stack).
 
 :- pred ml_gen_info_current_success_cont(success_cont,
@@ -3427,8 +3633,8 @@
 :- mode ml_gen_info_current_success_cont(out, in, out) is det.
 
 ml_gen_info_current_success_cont(SuccCont,
-		ml_gen_info(A, B, C, D, E, F, G, Stack),
-		ml_gen_info(A, B, C, D, E, F, G, Stack)) :-
+		ml_gen_info(A, B, C, D, E, F, G, H, Stack),
+		ml_gen_info(A, B, C, D, E, F, G, H, Stack)) :-
 	stack__top_det(Stack, SuccCont).
 
 %-----------------------------------------------------------------------------%
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.9
diff -u -d -r1.9 mlds.m
--- compiler/mlds.m	1999/10/31 22:39:06	1.9
+++ compiler/mlds.m	1999/11/05 20:00:24
@@ -11,7 +11,6 @@
 % The MLDS is an intermediate data structure used in compilation;
 % we compile Mercury source -> parse tree -> HLDS -> MLDS -> target (e.g. C).
 % See notes/compiler_design.html for more information about the MLDS & LLDS.
-% [XXX Need to document MLDS in notes/compiler_design.html.]
 %
 % The MLDS is intended to be suitable for generating target code in
 % languages such as Java, Java bytecode, high-level C, C++, or C--, etc.
@@ -456,6 +455,10 @@
 		% to handle nondeterminism
 	;	mlds__cont_type
 
+		% The type used for storing information about a commit.
+		% This may be `jmp_buf' or `__label__'.
+	;	mlds__commit_type
+
 		% MLDS native builtin types.
 		% These are the builtin types of the MLDS target language,
 		% whatever that may be.
@@ -638,10 +641,58 @@
 						% returning more than one value
 						
 	%
+	% commits (a specialized form of exception handling)
+	%
+
+		% try_commit(Ref, GoalToTry, CommitHandlerGoal):
+		%	Execute GoalToTry.  If GoalToTry exits via a
+		%	`commit(Ref)' instruction, then execute
+		%	CommitHandlerGoal.
+		%
+		% do_commit(Ref):
+		%	Unwind the stack to the corresponding `try_commit'
+		%	statement for Ref, and branch to the CommitHandlerGoal
+		%	that was specified in that try_commit instruction.
+		%
+		% For both try_commit and commit instructions,
+		% Ref should be the name of a local variable of type
+		% mlds__commit_type.  There should be exactly
+		% one try_commit instruction for each Ref.
+		% do_commit(Ref) instructions should only be used
+		% in goals called from the GoalToTry goal in the
+		% try_commit instruction with the same Ref.
+		%	
+	;	try_commit(mlds__var, mlds__statement, mlds__statement)
+	;	do_commit(mlds__var)
+
+	%
 	% exception handling
 	%
+/*********
+XXX Full exception handling support is not yet implemented.
 
-	/* XXX not yet implemented */
+	% We use C++-style exceptions.
+	% For C, the back-end can simulate them using setjmp/longjmp.
+	%
+	% XXX This is tentative -- the current definition may be
+	% a bit too specific to C++-style exceptions.
+	% It might not be a good choice for different target languages.
+
+		% throw the specified exception
+	;	throw(mlds__type, mlds__rval)
+
+		% rethrow the current exception
+		% (only valid inside an exception handler)
+	;	rethrow
+
+		% Execute the specified statement, and if it throws an exception,
+		% and the exception matches any of the exception handlers,
+		% then execute the first matching exception handler.
+	;	try_catch(
+			mlds__statement,
+			list(mlds__exception_handler)
+		)
+**********/
 
 	%
 	% atomic statements
@@ -660,6 +711,22 @@
 	.
 
 
+	% XXX This is tentative -- the current definition may be
+	% a bit too specific to C++-style exceptions.
+	% It might not be a good choice for different target languages.
+:- type mlds__exception_handler
+	--->	handler(
+			maybe(mlds__type),
+				% if `yes(T)', specifies the type of exceptions to catch
+				% if `no', it means catch all exceptions
+
+			maybe(string)
+				% if `yes(Name)', gives the variable name to use for
+				%	the exception value
+				% if `no', then exception value will not be used
+		).
+
+
 	%
 	% atomic statements
 	%
@@ -915,7 +982,7 @@
 			% module name; which var
 
 :- type mlds__data_name
-	--->	var(string)
+	--->	var(mlds__var_name)
 			% ordinary variables
 	;	common(int)
 			% Compiler-introduced constants representing
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.7
diff -u -d -r1.7 mlds_to_c.m
--- compiler/mlds_to_c.m	1999/09/20 22:46:36	1.7
+++ compiler/mlds_to_c.m	1999/11/05 20:19:43
@@ -90,6 +90,14 @@
 	Defn = mlds__defn(_Name, _Context, Flags, _Body),
 	access(Flags) \= private.
 
+:- 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(int, mlds__imports, io__state, io__state).
 :- mode mlds_output_hdr_imports(in, in, di, uo) is det.
 
@@ -226,7 +234,13 @@
 :- mode mlds_output_defns(in, in, in, di, uo) is det.
 
 mlds_output_defns(Indent, ModuleName, Defns) -->
-	list__foldl(mlds_output_defn(Indent, ModuleName), Defns).
+	%
+	% GNU C __label__ declarations must precede
+	% ordinary variable declarations.
+	%
+	{ list__filter(defn_is_commit_type_var, Defns, LabelDecls, OtherDefns) },
+	list__foldl(mlds_output_defn(Indent, ModuleName), LabelDecls),
+	list__foldl(mlds_output_defn(Indent, ModuleName), OtherDefns).
 
 
 :- pred mlds_output_decl(int, mlds_module_name, mlds__defn,
@@ -396,8 +410,14 @@
 	;
 		{ MaybeBody = yes(Body) },
 		io__write_string("\n"),
-		% require Body0 = statement(block(_, _), _)
-		mlds_output_statement(Indent, Name, Body)
+		%
+		% C requires function bodies to be blocks
+		%
+		( { Body = statement(block(_, _), _) } ->
+			mlds_output_statement(Indent, Name, Body)
+		;
+			mlds_output_stmt(Indent, Name, block([], [Body]))
+		)
 	).
 
 :- pred mlds_output_func_decl(int, qualified_entity_name, func_params, 
@@ -570,6 +590,9 @@
 mlds_output_type(mlds__ptr_type(Type)) -->
 	mlds_output_type(Type),
 	io__write_string(" *").
+mlds_output_type(mlds__commit_type) -->
+	% XXX this assumes GNU C
+	io__write_string("__label__").
 
 %-----------------------------------------------------------------------------%
 %
@@ -797,6 +820,43 @@
 	),
 	io__write_string(";\n").
 	
+	%
+	% commits
+	% XXX Currently we handle these using GNU C constructs.
+	%
+mlds_output_stmt(Indent, _FuncName, do_commit(Ref)) -->
+	mlds_indent(Indent),
+	io__write_string("goto "),
+	mlds_output_fully_qualified_name(Ref, io__write_string),
+	io__write_string(";\n").
+mlds_output_stmt(Indent, FuncName, try_commit(Ref, Stmt, Handler)) -->
+	
+	% Output the following:
+	%
+	%               <Stmt>
+	%               goto <Ref>_done;
+	%       <Ref>:
+	%               <Handler>
+	%       <Ref>_done:
+	%               ;
+
+	mlds_output_statement(Indent, FuncName, Stmt),
+
+	mlds_indent(Indent),
+	io__write_string("goto "),
+	mlds_output_fully_qualified_name(Ref, io__write_string),
+	io__write_string("_done;\n"),
+
+	mlds_indent(Indent - 1),
+	mlds_output_fully_qualified_name(Ref, io__write_string),
+	io__write_string(":\n"),
+
+	mlds_output_statement(Indent, FuncName, Handler),
+
+	mlds_indent(Indent - 1),
+	mlds_output_fully_qualified_name(Ref, io__write_string),
+	io__write_string("_done:\t;\n").
+
 	%
 	% exception handling
 	%

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