[m-rev.] diff: implement io__stream as foreign type

Fergus Henderson fjh at cs.mu.OZ.AU
Thu May 16 18:22:41 AEST 2002


On 08-May-2002, Peter Ross <peter.ross at miscrit.be> wrote:
> Once this bootchecks, I will check it in.
...
> Change the type io__stream to be implemented using pragma foreign_type.
> This should make it easier to port the library to the il grade.

This change broke
	(1) the tests of the hlc.agc grade
	(2) the `--target asm' back-end
	(3) bootstrapping on taifun, apparently since a sufficiently
	    recent compiler hadn't been installed on taifun

I have since fixed (1).
I will post a fix for (2) shortly.
But in the mean time, I'm going to back out this change.

In general, the current implementation of `pragma foreign_type'
for C looks broken in several important respects:

	- The interface of procedures exported with `pragma export'
	  should be the same regardless of the back-end, but this
	  is currently not the case.

	- The foreign name should be used for `pragma export'.

	- The MLDS->C back-end should use `MR_Box', not the foreign type
	  name, for representing foreign types internally.
	  This is needed to maintain binary compatibility with the
	  `--target asm' back-end.
	  (The foreign name should be used only for `pragma foreign_proc'
	  and `pragma export', not internally.)

	- All reasonable C types should be handled, regardless of their size.
	  The Mercury compiler should do boxing/unboxing automatically,
	  if needed.

I will have a go at fixing some of these.

----------

Estimated hours taken: 2
Branches: main

library/io.m:
	Back out Pete's earlier change to define io_stream using
	`pragma foreign_type', since this breaks the `--target asm'
	back-end.

Workspace: /home/ceres/fjh/mercury
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.255
diff -u -d -r1.255 io.m
--- library/io.m	16 May 2002 05:20:52 -0000	1.255
+++ library/io.m	16 May 2002 07:55:38 -0000
@@ -1318,10 +1318,7 @@
 
 :- type io__binary_stream ==	io__stream.
 
-:- type io__stream.
-:- pragma foreign_type(c, io__stream, "MercuryFile *").
-:- pragma foreign_type(il, io__stream,
-		"class [mercury]mercury.io__cpp_code.MR_MercuryFileStruct").
+:- type io__stream == c_pointer.
 
 	% a unique identifier for an IO stream
 :- type io__stream_id == int.
@@ -1900,7 +1897,8 @@
 		IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, thread_safe],
 "{
-	MR_MercuryFile mf = Stream;
+	MR_MercuryFile mf = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	if (mf->stream->get_CanSeek()) {
 		Size = mf->stream->get_Length();
 	} else {
@@ -3090,7 +3088,8 @@
 :- pragma foreign_proc("MC++",
 	io__get_stream_id(Stream::in, Id::out), 
 		[will_not_call_mercury, promise_pure], "
-	MR_MercuryFile mf = Stream;
+	MR_MercuryFile mf = ML_DownCast(MR_MercuryFile,
+		MR_word_to_c_pointer(Stream));
 	Id = mf->id;
 ").
 
@@ -3939,7 +3938,8 @@
 :- pragma foreign_proc("MC++", 
 	io__read_char_code(File::in, CharCode::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure], "
-	MR_MercuryFile mf = File;
+	MR_MercuryFile mf = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(File));
 	CharCode = mercury_getc(mf);
 	update_io(IO0, IO);
 ").
@@ -3948,7 +3948,8 @@
 	io__putback_char(File::in, Character::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure], "{
 
-	MR_MercuryFile mf = File;
+	MR_MercuryFile mf = ML_DownCast(MR_MercuryFile,
+		MR_word_to_c_pointer(File));
 	if (Character == '\\n') {
 		mf->line_number--;
 	}
@@ -3960,7 +3961,8 @@
 	io__putback_byte(File::in, _Character::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure], "{
 
-	MR_MercuryFile mf = File;
+	MR_MercuryFile mf = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(File));
 	mf->stream->Seek(-1, System::IO::SeekOrigin::Current);
 	update_io(IO0, IO);
 }").
@@ -4293,7 +4295,8 @@
 	io__write_string(Stream::in, Message::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure, thread_safe, tabled_for_io], 
 "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	mercury_print_string(stream, Message);
 	update_io(IO0, IO);
 }").
@@ -4302,7 +4305,8 @@
 	io__write_char(Stream::in, Character::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure, thread_safe, tabled_for_io], 
 "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	System::IO::StreamWriter *w = new System::IO::StreamWriter(
 		mercury_current_binary_output->stream);
 	w->Write(Character);
@@ -4314,7 +4318,8 @@
 	io__write_int(Stream::in, Val::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	System::IO::StreamWriter *w = new System::IO::StreamWriter(
 		mercury_current_binary_output->stream);
 	w->Write(Val.ToString());
@@ -4326,7 +4331,8 @@
 	io__write_float(Stream::in, Val::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	System::IO::StreamWriter *w = new System::IO::StreamWriter(
 		mercury_current_binary_output->stream);
 	w->Write(Val.ToString());
@@ -4340,7 +4346,8 @@
 "{
 	mercury::runtime::Errors::SORRY(""foreign code for this function"");
 		// something like this...
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	System::IO::StreamWriter *w = new System::IO::StreamWriter(
 		mercury_current_binary_output->stream);
 	w->Write(Byte.ToString());
@@ -4352,7 +4359,8 @@
 	io__write_bytes(Stream::in, Message::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	mercury_print_binary_string(stream, Message);
 	update_io(IO0, IO);
 }").
@@ -4361,7 +4369,8 @@
 	io__flush_output(Stream::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	stream->stream->Flush();
 	update_io(IO0, IO);
 }").
@@ -4370,7 +4379,8 @@
 	io__flush_binary_output(Stream::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure, thread_safe, tabled_for_io],
 "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	stream->stream->Flush();
 	update_io(IO0, IO);
 }").
@@ -4387,7 +4397,7 @@
 		[will_not_call_mercury, promise_pure, tabled_for_io,
 			thread_safe],
 "
-	Stream = &mercury_stdin;
+	Stream = (MR_Word) &mercury_stdin;
 	update_io(IO0, IO);
 ").
 
@@ -4396,7 +4406,7 @@
 		[will_not_call_mercury, promise_pure, tabled_for_io,
 			thread_safe],
 "
-	Stream = &mercury_stdout;
+	Stream = (MR_Word) &mercury_stdout;
 	update_io(IO0, IO);
 ").
 
@@ -4405,7 +4415,7 @@
 		[will_not_call_mercury, promise_pure, tabled_for_io,
 			thread_safe],
 "
-	Stream = &mercury_stderr;
+	Stream = (MR_Word) &mercury_stderr;
 	update_io(IO0, IO);
 ").
 
@@ -4414,7 +4424,7 @@
 		[will_not_call_mercury, promise_pure, tabled_for_io,
 			thread_safe],
 "
-	Stream = &mercury_stdin_binary;
+	Stream = (MR_Word) &mercury_stdin_binary;
 	update_io(IO0, IO);
 ").
 
@@ -4423,7 +4433,7 @@
 		[will_not_call_mercury, promise_pure, tabled_for_io,
 			thread_safe],
 "
-	Stream = &mercury_stdout_binary;
+	Stream = (MR_Word) &mercury_stdout_binary;
 	update_io(IO0, IO);
 ").
 
@@ -4431,7 +4441,7 @@
 	io__input_stream(Stream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	Stream = mercury_current_text_input;
+	Stream = (MR_Word) mercury_current_text_input;
 	update_io(IO0, IO);
 ").
 
@@ -4439,7 +4449,7 @@
 	io__output_stream(Stream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	Stream = mercury_current_text_output;
+	Stream = (MR_Word) mercury_current_text_output;
 	update_io(IO0, IO);
 ").
 
@@ -4447,7 +4457,7 @@
 	io__binary_input_stream(Stream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	Stream = mercury_current_binary_input;
+	Stream = (MR_Word) mercury_current_binary_input;
 	update_io(IO0, IO);
 ").
 
@@ -4455,7 +4465,7 @@
 	io__binary_output_stream(Stream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	Stream = mercury_current_binary_output;
+	Stream = (MR_Word) mercury_current_binary_output;
 	update_io(IO0, IO);
 ").
 
@@ -4532,7 +4542,7 @@
 	io__current_input_stream(OutStream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	OutStream = mercury_current_text_input;
+	OutStream = (MR_Word) mercury_current_text_input;
 	update_io(IO0, IO);
 ").
 
@@ -4540,7 +4550,7 @@
 	io__current_output_stream(OutStream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	OutStream = mercury_current_text_output;
+	OutStream = (MR_Word) mercury_current_text_output;
 	update_io(IO0, IO);
 ").
 
@@ -4548,7 +4558,7 @@
 	io__current_binary_input_stream(OutStream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	OutStream = mercury_current_binary_input;
+	OutStream = (MR_Word) mercury_current_binary_input;
 	update_io(IO0, IO);
 ").
 
@@ -4556,7 +4566,7 @@
 	io__current_binary_output_stream(OutStream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	OutStream = mercury_current_binary_output;
+	OutStream = (MR_Word) mercury_current_binary_output;
 	update_io(IO0, IO);
 ").
 
@@ -4568,7 +4578,7 @@
 		IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	OutStream = mercury_current_text_input;
+	OutStream = (MR_Word) mercury_current_text_input;
 	mercury_current_text_input = (MercuryFile *) NewStream;
 	update_io(IO0, IO);
 ").
@@ -4578,7 +4588,7 @@
 		IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	OutStream = mercury_current_text_output;
+	OutStream = (MR_Word) mercury_current_text_output;
 	mercury_current_text_output = (MercuryFile *) NewStream;
 	update_io(IO0, IO);
 ").
@@ -4588,7 +4598,7 @@
 		IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	OutStream = mercury_current_binary_input;
+	OutStream = (MR_Word) mercury_current_binary_input;
 	mercury_current_binary_input = (MercuryFile *) NewStream;
 	update_io(IO0, IO);
 ").
@@ -4598,7 +4608,7 @@
 		IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	OutStream = mercury_current_binary_output;
+	OutStream = (MR_Word) mercury_current_binary_output;
 	mercury_current_binary_output = (MercuryFile *) NewStream;
 	update_io(IO0, IO);
 ").
@@ -4608,7 +4618,7 @@
 		[will_not_call_mercury, promise_pure, thread_safe,
 			tabled_for_io],
 "
-	Stream = mercury_stdin;
+	MR_c_pointer_to_word(Stream, mercury_stdin);
 	update_io(IO0, IO);
 ").
 
@@ -4617,7 +4627,7 @@
 		[will_not_call_mercury, promise_pure, thread_safe,
 			tabled_for_io],
 "
-	Stream = mercury_stdout;
+	MR_c_pointer_to_word(Stream, mercury_stdout);
 	update_io(IO0, IO);
 ").
 
@@ -4626,7 +4636,7 @@
 		[will_not_call_mercury, promise_pure, thread_safe,
 			tabled_for_io],
 "
-	Stream = mercury_stderr;
+	MR_c_pointer_to_word(Stream, mercury_stderr);
 	update_io(IO0, IO);
 ").
 
@@ -4635,7 +4645,7 @@
 		[will_not_call_mercury, promise_pure, thread_safe,
 			tabled_for_io],
 "
-	Stream = mercury_stdin_binary;
+	MR_c_pointer_to_word(Stream, mercury_stdin_binary);
 	update_io(IO0, IO);
 ").
 
@@ -4644,7 +4654,7 @@
 		[will_not_call_mercury, promise_pure, thread_safe,
 			tabled_for_io],
 "
-	Stream = mercury_stdout_binary;
+	MR_c_pointer_to_word(Stream, mercury_stdout_binary);
 	update_io(IO0, IO);
 ").
 
@@ -4652,7 +4662,7 @@
 	io__input_stream(Stream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	Stream = mercury_current_text_input;
+	MR_c_pointer_to_word(Stream, mercury_current_text_input);
 	update_io(IO0, IO);
 ").
 
@@ -4660,7 +4670,7 @@
 	io__output_stream(Stream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	Stream = mercury_current_text_output;
+	MR_c_pointer_to_word(Stream, mercury_current_text_output);
 	update_io(IO0, IO);
 ").
 
@@ -4668,7 +4678,7 @@
 	io__binary_input_stream(Stream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	Stream = mercury_current_binary_input;
+	MR_c_pointer_to_word(Stream, mercury_current_binary_input);
 	update_io(IO0, IO);
 ").
 
@@ -4676,7 +4686,7 @@
 	io__binary_output_stream(Stream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "
-	Stream = mercury_current_binary_output;
+	MR_c_pointer_to_word(Stream, mercury_current_binary_output);
 	update_io(IO0, IO);
 ").
 
@@ -4692,7 +4702,8 @@
 	io__get_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	LineNum = stream->line_number;
 	update_io(IO0, IO);
 }").
@@ -4709,7 +4720,8 @@
 	io__set_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io],
 "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	stream->line_number = LineNum;
 	update_io(IO0, IO);
 }").
@@ -4724,7 +4736,8 @@
 :- pragma foreign_proc("MC++",
 	io__get_output_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io], "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	LineNum = stream->line_number;
 	update_io(IO0, IO);
 }").
@@ -4739,7 +4752,8 @@
 :- pragma foreign_proc("MC++",
 	io__set_output_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io], "{
-	MR_MercuryFile stream = Stream;
+	MR_MercuryFile stream = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	stream->line_number = LineNum;
 	update_io(IO0, IO);
 }").
@@ -4750,16 +4764,18 @@
 :- pragma foreign_proc("MC++",
 	io__set_input_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io], "
-	OutStream = mercury_current_text_input;
-	mercury_current_text_input = NewStream;
+	MR_c_pointer_to_word(OutStream, mercury_current_text_input);
+	mercury_current_text_input = 
+		ML_DownCast(MR_MercuryFile, MR_word_to_c_pointer(NewStream));
 	update_io(IO0, IO);
 ").
 
 :- pragma foreign_proc("MC++",
 	io__set_output_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
 		[will_not_call_mercury, promise_pure, tabled_for_io], "
-	OutStream = mercury_current_text_output;
-	mercury_current_text_output = NewStream;
+	MR_c_pointer_to_word(OutStream, mercury_current_text_output);
+	mercury_current_text_output = 
+		ML_DownCast(MR_MercuryFile, MR_word_to_c_pointer(NewStream));
 	update_io(IO0, IO);
 ").
 
@@ -4767,8 +4783,9 @@
 	io__set_binary_input_stream(NewStream::in, OutStream::out,
 		IO0::di, IO::uo), 
 		[will_not_call_mercury, promise_pure, tabled_for_io], "
-	OutStream = mercury_current_binary_input;
-	mercury_current_binary_input = NewStream;
+	MR_c_pointer_to_word(OutStream, mercury_current_binary_input);
+	mercury_current_binary_input = 
+		ML_DownCast(MR_MercuryFile, MR_word_to_c_pointer(NewStream));
 	update_io(IO0, IO);
 ").
 
@@ -4776,8 +4793,9 @@
 	io__set_binary_output_stream(NewStream::in, OutStream::out,
 		IO0::di, IO::uo), 
 		[will_not_call_mercury, promise_pure, tabled_for_io], "
-	OutStream = mercury_current_binary_output;
-	mercury_current_binary_output = NewStream;
+	MR_c_pointer_to_word(OutStream, mercury_current_binary_output);
+	mercury_current_binary_output = 
+		ML_DownCast(MR_MercuryFile, MR_word_to_c_pointer(NewStream));
 	update_io(IO0, IO);
 ").
 
@@ -4793,7 +4811,7 @@
 		[will_not_call_mercury, promise_pure, tabled_for_io,
 			thread_safe],
 "
-	Stream = mercury_open(FileName, Mode);
+	Stream = (MR_Word) mercury_open(FileName, Mode);
 	ResultCode = (Stream ? 0 : -1);
 	update_io(IO0, IO);
 ").
@@ -4805,7 +4823,7 @@
 			thread_safe],
 "
 	MR_MercuryFile mf = mercury_open(FileName, Mode);
-	Stream = mf;
+	MR_c_pointer_to_word(Stream, mf);
 	ResultCode = (mf ? 0 : -1);
 	update_io(IO0, IO);
 ").
@@ -4836,7 +4854,8 @@
 
 :- pragma foreign_proc("MC++", io__close_stream(Stream::in, IO0::di, IO::uo),
 		[may_call_mercury, promise_pure, tabled_for_io, thread_safe], "
-	MR_MercuryFile mf = Stream;
+	MR_MercuryFile mf = ML_DownCast(MR_MercuryFile, 
+		MR_word_to_c_pointer(Stream));
 	mercury_close(mf);
 	update_io(IO0, IO);
 ").

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list