[m-dev.] diff: --high-level-data, part 3

[Fergus Henderson]

Estimated hours taken: 0.5

compiler/ml_code_gen.m:
	When generating MLDS code for `pragma c_code' goals,
	add some extra casts that are needed when you use --high-level-data.

Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.49
diff -u -d -b -r1.49 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/05/31 06:03:57	1.49
+++ compiler/ml_code_gen.m	2000/05/31 07:28:46
@@ -1838,8 +1838,8 @@
 	),
 	{ Starting_C_Code_Stmt = target_code(lang_C, Starting_C_Code) },
 	{ Ending_C_Code_Stmt = target_code(lang_C, Ending_C_Code) },
-	{ Starting_C_Code_Statement = mlds__statement(atomic(Starting_C_Code_Stmt),
-		mlds__make_context(Context)) },
+	{ Starting_C_Code_Statement = mlds__statement(
+		atomic(Starting_C_Code_Stmt), mlds__make_context(Context)) },
 	{ Ending_C_Code_Statement = mlds__statement(atomic(Ending_C_Code_Stmt),
 		mlds__make_context(Context)) },
 	{ MLDS_Statements = list__condense([
@@ -2002,12 +2002,30 @@
 			ml_gen_box_or_unbox_rval(VarType, OrigType,
 				lval(VarLval), ArgRval)
 		),
-		{ type_util__var(VarType, _) ->
+		{ module_info_globals(ModuleInfo, Globals) },
+		{ globals__lookup_bool_option(Globals, highlevel_data,
+			HighLevelData) },
+		{ HighLevelData = yes ->
+			% In general, the types used for the C interface
+			% are not the same as the types used by
+			% --high-level-data, so we always use a cast here.
+			% (Strictly speaking the cast is not needed for
+			% a few cases like `int', but it doesn't do any harm.)
+			export__type_to_type_string(OrigType, TypeString),
+			string__format("(%s)", [s(TypeString)], Cast)
+		;
+			% For --no-high-level-data, we only need to use
+			% a cast is for polymorphic types, which are
+			% `Word' in the C interface but `MR_Box' in the
+			% MLDS back-end.
+			( type_util__var(OrigType, _) ->
 			Cast = "(MR_Word) "
 		;
 			Cast = ""
+			)
 		},
-		{ string__format("\t%s = %s\n", [s(ArgName), s(Cast)],
+		{ string__format("\t%s = %s\n",
+			[s(ArgName), s(Cast)],
 			AssignToArgName) },
 		{ AssignInput = [
 			raw_target_code(AssignToArgName),
@@ -2058,15 +2076,38 @@
 		ml_gen_var(Var, VarLval),
 		ml_gen_box_or_unbox_lval(VarType, OrigType, VarLval, ArgName,
 			Context, ArgLval, ConvDecls, ConvStatements),
-		{ type_util__var(VarType, _) ->
-			Cast = "(MR_Box) "
+		{ module_info_globals(ModuleInfo, Globals) },
+		{ globals__lookup_bool_option(Globals, highlevel_data,
+			HighLevelData) },
+		{ HighLevelData = yes ->
+			% In general, the types used for the C interface
+			% are not the same as the types used by
+			% --high-level-data, so we always use a cast here.
+			% (Strictly speaking the cast is not needed for
+			% a few cases like `int', but it doesn't do any harm.)
+			% Note that we can't easily obtain the type string
+			% for the RHS of the assignment, so instead we
+			% cast the LHS.
+			export__type_to_type_string(OrigType, TypeString),
+			string__format("*(%s *)&", [s(TypeString)], LHS_Cast),
+			RHS_Cast = ""
 		;
-			Cast = ""
+			% For --no-high-level-data, we only need to use
+			% a cast is for polymorphic types, which are
+			% `Word' in the C interface but `MR_Box' in the
+			% MLDS back-end.
+			( type_util__var(VarType, _) ->
+				RHS_Cast = "(MR_Box) "
+			;
+				RHS_Cast = ""
+			),
+			LHS_Cast = ""
 		},
-		{ string__format(" = %s%s;\n", [s(Cast), s(ArgName)],
+		{ string__format(" = %s%s;\n", [s(RHS_Cast), s(ArgName)],
 			AssignFromArgName) },
+		{ string__format("\t%s", [s(LHS_Cast)], AssignTo) },
 		{ AssignOutput = [
-			raw_target_code("\t"),
+			raw_target_code(AssignTo),
 			target_code_output(ArgLval),
 			raw_target_code(AssignFromArgName)
 		] }

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