[m-rev.] for review: fix .NET commit handling

[Tyson Dowd]

Hi,

Here's a better version of the diff I put up before.
This generates the commit variables as locals of the commit function,
which means they don't get put into the environments at all.

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


Estimated hours taken: 1
Branches: main

Fix the handling of commits in .NET.

compiler/ml_code_gen.m:
	Initialize (new_object) the commit object just before we throw it.

compiler/ml_elim_nested.m:
	Don't initialize the commit object inside the constructor for the
	class -- this hard to maintain and may not always be correct.

compiler/mlds_to_il.m:
	Fix rval_to_type to correct get the type from var references, and
	handle box/unbox and cast unops.



Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.89
diff -u -r1.89 ml_code_gen.m
--- compiler/ml_code_gen.m	2001/06/22 09:14:30	1.89
+++ compiler/ml_code_gen.m	2001/07/11 12:21:38
@@ -1582,18 +1582,38 @@
 		/* push nesting level */
 		{ MLDS_Context = mlds__make_context(Context) },
 		ml_gen_info_new_commit_label(CommitLabelNum),
-		{ CommitRef = mlds__var_name(
-			string__format("commit_%d", [i(CommitLabelNum)]),
-			no) },
-		ml_gen_var_lval(CommitRef, mlds__commit_type, CommitRefLval),
+		{ CommitRef = mlds__var_name(string__format("commit_%d",
+			[i(CommitLabelNum)]), no) },
+		ml_gen_var_lval(CommitRef, mlds__commit_type,
+			CommitRefLval),
 		{ CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context,
 			CommitRef) },
 		{ DoCommitStmt = do_commit(lval(CommitRefLval)) },
-		{ DoCommitStatement = mlds__statement(DoCommitStmt,
-			MLDS_Context) },
+		{ DoCommitStatement = 
+			mlds__statement(DoCommitStmt, MLDS_Context) },
+		=(MLDSGenInfo),
+		{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
+		{ module_info_globals(ModuleInfo, Globals) },
+		{ globals__get_target(Globals, Target) },
+		{ Target = il ->
+				% XXX would be a good performance thing
+				% to re-use the same pre-allocated commit
+				% object over and over again, instead of
+				% allocating them each time.
+			NewCommitObject = mlds__statement(
+				atomic(new_object(CommitRefLval, no,
+					mlds__commit_type, no, no, [], [])),
+					MLDS_Context),
+			DoCommitBody = ml_gen_block([CommitRefDecl], 
+				[NewCommitObject,
+				DoCommitStatement],
+				Context)
+		;
+			DoCommitBody = DoCommitStatement
+		},
 		/* pop nesting level */
 		ml_gen_nondet_label_func(SuccessFuncLabel, Context,
-			DoCommitStatement, SuccessFunc),
+			DoCommitBody, SuccessFunc),
 
 		ml_get_env_ptr(EnvPtrRval),
 		{ SuccessCont = success_cont(SuccessFuncLabelRval,
@@ -1616,8 +1636,13 @@
 				[SetSuccessTrue]), Context)) },
 		{ TryCommitStatement = mlds__statement(TryCommitStmt,
 			MLDS_Context) },
-		{ CommitFuncLocalDecls = [CommitRefDecl, SuccessFunc |
-			GoalStaticDecls] },
+		{ Target = il ->
+			CommitFuncLocalDecls = [SuccessFunc |
+				GoalStaticDecls]
+		;
+			CommitFuncLocalDecls = [CommitRefDecl, SuccessFunc |
+				GoalStaticDecls]
+		},
 		maybe_put_commit_in_own_func(CommitFuncLocalDecls,
 			[TryCommitStatement], Context,
 			CommitFuncDecls, MLDS_Statements),
@@ -2182,7 +2207,7 @@
 	=(MLDSGenInfo),
 	{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
 	{ module_info_globals(ModuleInfo, Globals) },
-	{ globals__lookup_string_option(Globals, target, Target) },
+	{ globals__get_target(Globals, Target) },
 	( { CodeModel = model_non } ->
 
 		% For IL code, we can't call continutations because
@@ -2193,7 +2218,7 @@
 		% continuation call.
 		
 		(
-			{ Target = "il" }
+			{ Target = il }
 		->
 			ml_gen_call_current_success_cont_indirectly(Context,
 				CallCont)
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.32
diff -u -r1.32 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2001/07/11 10:27:05	1.32
+++ compiler/ml_elim_nested.m	2001/07/11 12:21:38
@@ -380,24 +380,16 @@
 		% away.
 	globals__get_target(Globals, Target),
 	( Target = il ->
-			% Generate a ctor for the class which
-			% initilaises the commit field.
-		ThisPtr = self(mlds__commit_type),
-		FieldType = mlds__commit_type,
-		CtorType = mlds__commit_type,
-		PtrType = EnvTypeName,	
-			
-			% Note we have to do the correct name mangling
-			% for the IL backend.
-		FieldName = qual(mlds__append_name(ModuleName,
-				EnvClassName ++ "_0"), "commit_1"),
-		Lval = field(no, ThisPtr, named_field(FieldName, CtorType),
-				FieldType, PtrType),
+			% Generate a ctor for the class.
 
-		Rval = new_object(Lval, no, FieldType, no, no, [], []),
+			% XXX we can't generate an empty constructor,
+			% because the IL backend interprets that as
+			% :- external.
+			% So we generate an empty block instead.
+		Stmt = mlds__statement(block([], []), Context),
 
-		Stmt = mlds__statement(atomic(Rval), Context),
-		Ctor = mlds__function(no, func_params([], []), yes(Stmt)),
+		Ctor = mlds__function(no, func_params([], []),
+				yes(Stmt)),
 		CtorFlags = init_decl_flags(public, per_instance, non_virtual,
 				overridable, modifiable, concrete),
 
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.42
diff -u -r1.42 mlds_to_il.m
--- compiler/mlds_to_il.m	2001/07/11 10:24:36	1.42
+++ compiler/mlds_to_il.m	2001/07/11 12:21:52
@@ -1050,10 +1050,9 @@
 maybe_box_initializer(init_struct(X), init_struct(X)) --> [].
 	% single items need to be boxed
 maybe_box_initializer(init_obj(Rval), init_obj(NewRval)) -->
-	rval_to_type(Rval, BoxType),
+	{ rval_to_type(Rval, BoxType) },
 	{ NewRval = unop(box(BoxType), Rval) }.
 
-
 %-----------------------------------------------------------------------------%
 %
 % Convert basic MLDS statements into IL.
@@ -1276,7 +1275,7 @@
 	statement_to_il(CommitHandlerGoal, HandlerInstrsTree),
 	il_info_make_next_label(DoneLabel),
 
-	rval_to_type(lval(Ref), MLDSRefType),
+	{ rval_to_type(lval(Ref), MLDSRefType) },
 	DataRep =^ il_data_rep,
 	{ ClassName = mlds_type_to_ilds_class_name(DataRep, MLDSRefType) },
 	{ Instrs = tree__list([
@@ -2716,46 +2715,44 @@
 	% constants to the MLDS version of their IL representation).
 	% This is so you can generate appropriate box rvals for
 	% rval_consts.
+
+:- pred rval_to_type(mlds__rval::in, mlds__type::out) is det.
+
+rval_to_type(lval(var(_, Type)), Type).
+rval_to_type(lval(field(_, _, _, Type, _)), Type).
+rval_to_type(lval(mem_ref(_, Type)), Type).
 
-:- pred rval_to_type(mlds__rval::in, mlds__type::out,
-		il_info::in, il_info::out) is det.
+rval_to_type(mkword(_, _), _) :-
+	unexpected(this_file, "rval_to_type: mkword").
 
-rval_to_type(lval(Lval), Type, Info0, Info) :- 
-	( Lval = var(Var, _VarType),
-		mangle_mlds_var(Var, MangledVarStr),
-		il_info_get_mlds_type(MangledVarStr, Type, Info0, Info)
-	; Lval = field(_, _, _, Type, _),
-		Info = Info0
-	; Lval = mem_ref(_Rval, Type),
-		Info = Info0
+rval_to_type(unop(Unop, _), Type) :- 
+	( 
+		Unop = box(_),
+		Type = mlds__generic_type
+	; 
+		Unop = unbox(UnboxType),
+		Type = UnboxType
+	; 
+		Unop = cast(CastType),
+		Type = CastType
+	; 
+		Unop = std_unop(StdUnop),
+		functor(StdUnop, StdUnopStr, _Arity),
+		unexpected(this_file, "rval_to_type: unop: " ++ StdUnopStr)
 	).
 
-	% The following five conversions should never occur or be boxed
-	% anyway, but just in case they are we make them reference
-	% mercury.invalid which is a non-exisitant class.   If we try to
-	% run this code, we'll get a runtime error.
-	% XXX can we just call error?
-rval_to_type(mkword(_Tag, _Rval), Type, I, I) :- 
-	ModuleName = mercury_module_name_to_mlds(unqualified("mercury")),
-	Type = mlds__class_type(qual(ModuleName, "invalid"),
-		0, mlds__class).
-rval_to_type(unop(_, _), Type, I, I) :- 
-	ModuleName = mercury_module_name_to_mlds(unqualified("mercury")),
-	Type = mlds__class_type(qual(ModuleName, "invalid"),
-		0, mlds__class).
-rval_to_type(binop(_, _, _), Type, I, I) :- 
-	ModuleName = mercury_module_name_to_mlds(unqualified("mercury")),
-	Type = mlds__class_type(qual(ModuleName, "invalid"),
-		0, mlds__class).
-rval_to_type(mem_addr(_), Type, I, I) :-
-	ModuleName = mercury_module_name_to_mlds(unqualified("mercury")),
-	Type = mlds__class_type(qual(ModuleName, "invalid"),
-		0, mlds__class).
-rval_to_type(self(_), Type, I, I) :-
+rval_to_type(binop(_, _, _), _) :- 
+	unexpected(this_file, "rval_to_type: binop").
+
+rval_to_type(mem_addr(_), _) :-
+	unexpected(this_file, "rval_to_type: mem_addr").
+
+rval_to_type(self(_), Type) :-
 	ModuleName = mercury_module_name_to_mlds(unqualified("mercury")),
 	Type = mlds__class_type(qual(ModuleName, "invalid"),
 		0, mlds__class).
-rval_to_type(const(Const), Type, I, I) :- 
+
+rval_to_type(const(Const), Type) :- 
 	Type = rval_const_to_type(Const).
 
 :- func rval_const_to_type(mlds__rval_const) = mlds__type.


-- 
       Tyson Dowd           # 
                            #  Surreal humour isn't everyone's cup of fur.
     trd at cs.mu.oz.au        # 
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------