[m-rev.] for review: printing streams sensibly in the debugger
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Sep 4 21:18:07 AEST 2003
For anyone to review.
Print streams sensibly in the debugger.
runtime/mercury_library_types.h:
Define MercuryFilePtr as a shorthand for MercuryFile *.
library/io.m:
Define a user-friendly representation for streams that includes not
just the stream's name but all the info about the stream that user
using mdb may wish to know about the stream, as well as a unique stream
id.
Make the changes required to maintain this improved stream database.
If the program is being executed under mdb, then do not ever delete
items from the stream database, since e.g. the declarative debugger
may need to print the stream's representation even after the stream
is closed. (If executing outside mdb, then we delete a stream's entry
from the stream database when the stream is closed, as before.)
To allow the debugger to detect which variables are I/O streams,
change the stream types from being equivalent to c_pointer (and thus
indistinguishable from other c_pointers) to their own type. Implement
this type as MercuryFilePtr in the C backend. In the IL backend, we
represent it as Object[], the minimum representation change possible.
Use the C type definition to get rid of many casts.
When writing streams, write the user-friendly representation, not
a meaningless <<c_pointer>>.
runtime/mercury_init.h:
runtime/mercury_wrapper.[ch]:
runtime/mercury_layout_util.c:
The change in stream's representation changes the types of some of the
arguments of functions exported to C from io.m; conform to those
changes.
browser/browse.m:
browser/sized_pretty.m:
In each of the mechanisms that the debugger can use to display terms,
pass along the stream name database.
browser/browser_info.m:
When deconstructing terms that are streams, return the stream's
user-friendly id, not a c_pointer.
browser/browse_test.m:
Update this test program to test the new way of printing streams.
runtime/mercury_trace_base.[ch]:
Define the MR_trace_ever_enabled variable to let io.m know whether
it is allowed to ever discard stream info.
runtime/mercury_init.h:
runtime/mercury_wrapper.[ch]:
Update the types of the functions dealing with streams to use
MercuryFilePtr to refer to streams instead of MR_Word. These functions
are implemented by Mercury predicates exported to C.
runtime/mercury_wrapper.c:
Set MR_trace_ever_enabled to true when execution tracing is enabled.
This is the only assigment to MR_trace_ever_enabled after
initialization to the default (false).
tests/debugger/declarative/io_stream_test.{m,inp,exp,exp}:
A new test case to test the debugger's printing of I/O streams.
tests/debugger/declarative/Mmakefile:
Enable the new test case.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
Index: browser/browse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.37
diff -u -r1.37 browse.m
--- browser/browse.m 26 May 2003 08:59:43 -0000 1.37
+++ browser/browse.m 27 Jul 2003 08:11:04 -0000
@@ -519,7 +519,9 @@
( { RemainingSize >= 0 } ->
portray_flat_write_browser_term(BrowserTerm)
;
- { browser_term_to_string(BrowserTerm, Params ^ size,
+ io__get_stream_db(StreamDb),
+ { BrowserDb = browser_db(StreamDb) },
+ { browser_term_to_string(BrowserDb, BrowserTerm, Params ^ size,
Params ^ depth, Str) },
write_string_debugger(Debugger, Str)
).
@@ -559,7 +561,9 @@
io__state::di, io__state::uo) is cc_multi.
portray_verbose(Debugger, BrowserTerm, Params) -->
- { browser_term_to_string_verbose(BrowserTerm, Params ^ size,
+ io__get_stream_db(StreamDb),
+ { BrowserDb = browser_db(StreamDb) },
+ { browser_term_to_string_verbose(BrowserDb, BrowserTerm, Params ^ size,
Params ^ depth, Params ^ width, Params ^ lines, Str) },
write_string_debugger(Debugger, Str).
@@ -575,7 +579,9 @@
io__state::di, io__state::uo) is cc_multi.
portray_pretty(Debugger, BrowserTerm, Params) -->
- { sized_pretty__browser_term_to_string_line(BrowserTerm,
+ io__get_stream_db(StreamDb),
+ { BrowserDb = browser_db(StreamDb) },
+ { sized_pretty__browser_term_to_string_line(BrowserDb, BrowserTerm,
Params ^ width, Params ^ lines, Str) },
write_string_debugger(Debugger, Str).
@@ -635,44 +641,44 @@
% Single-line representation of a term.
%
-:- pred browser_term_to_string(browser_term::in, int::in, int::in,
- string::out) is cc_multi.
+:- pred browser_term_to_string(browser_db::in, browser_term::in,
+ int::in, int::in, string::out) is cc_multi.
-browser_term_to_string(BrowserTerm, MaxSize, MaxDepth, Str) :-
+browser_term_to_string(BrowserDb, BrowserTerm, MaxSize, MaxDepth, Str) :-
CurSize = 0,
CurDepth = 0,
- browser_term_to_string_2(BrowserTerm, MaxSize, CurSize, _NewSize,
- MaxDepth, CurDepth, Str).
+ browser_term_to_string_2(BrowserDb, BrowserTerm,
+ MaxSize, CurSize, _NewSize, MaxDepth, CurDepth, Str).
% Note: When the size limit is reached, we simply display
% further subterms compressed. This is consistent with the
% User's Guide, which describes the size limit as a "suggested
% maximum".
-:- pred browser_term_to_string_2(browser_term::in, int::in, int::in, int::out,
- int::in, int::in, string::out) is cc_multi.
+:- pred browser_term_to_string_2(browser_db::in, browser_term::in,
+ int::in, int::in, int::out, int::in, int::in, string::out) is cc_multi.
-browser_term_to_string_2(BrowserTerm, MaxSize, CurSize, NewSize,
+browser_term_to_string_2(BrowserDb, BrowserTerm, MaxSize, CurSize, NewSize,
MaxDepth, CurDepth, Str) :-
- limited_deconstruct_browser_term_cc(BrowserTerm, MaxSize,
- MaybeFunctorArityArgs, MaybeReturn),
+ limited_deconstruct_browser_term_cc(BrowserDb, BrowserTerm, MaxSize,
+ MaybeFunctorArityArgs, MaybeReturn),
(
CurSize < MaxSize,
CurDepth < MaxDepth,
MaybeFunctorArityArgs = yes({Functor, _Arity, Args})
->
- browser_term_to_string_3(Functor, Args, MaybeReturn,
+ browser_term_to_string_3(BrowserDb, Functor, Args, MaybeReturn,
MaxSize, CurSize, NewSize, MaxDepth, CurDepth, Str)
;
- browser_term_compress(BrowserTerm, Str),
+ browser_term_compress(BrowserDb, BrowserTerm, Str),
NewSize = CurSize
).
-:- pred browser_term_to_string_3(string::in, list(univ)::in, maybe(univ)::in,
- int::in, int::in, int::out, int::in, int::in, string::out) is cc_multi.
-
-browser_term_to_string_3(Functor, Args, MaybeReturn, MaxSize, Size0, Size,
- MaxDepth, Depth0, Str) :-
+:- pred browser_term_to_string_3(browser_db::in, string::in,
+ list(univ)::in, maybe(univ)::in, int::in, int::in, int::out,
+ int::in, int::in, string::out) is cc_multi.
+browser_term_to_string_3(BrowserDb, Functor, Args, MaybeReturn,
+ MaxSize, Size0, Size, MaxDepth, Depth0, Str) :-
(
Functor = "[|]",
Args = [ListHead, ListTail],
@@ -683,10 +689,10 @@
% element of the list.
Size1 = Size0 + 1,
Depth1 = Depth0 + 1,
- browser_term_to_string_2(plain_term(ListHead), MaxSize,
- Size1, Size2, MaxDepth, Depth1, HeadStr),
- list_tail_to_string_list(ListTail, MaxSize, Size2, Size,
- MaxDepth, Depth1, TailStrs),
+ browser_term_to_string_2(BrowserDb, plain_term(ListHead),
+ MaxSize, Size1, Size2, MaxDepth, Depth1, HeadStr),
+ list_tail_to_string_list(BrowserDb, ListTail,
+ MaxSize, Size2, Size, MaxDepth, Depth1, TailStrs),
list__append(TailStrs, ["]"], Strs),
string__append_list(["[", HeadStr | Strs], Str)
;
@@ -699,13 +705,14 @@
;
Size1 = Size0 + 1,
Depth1 = Depth0 + 1,
- args_to_string_list(Args, MaxSize, Size1, Size2, MaxDepth,
- Depth1, ArgStrs),
+ args_to_string_list(BrowserDb, Args, MaxSize, Size1, Size2,
+ MaxDepth, Depth1, ArgStrs),
BracketedArgsStr = bracket_string_list(ArgStrs),
(
MaybeReturn = yes(Return),
- browser_term_to_string_2(plain_term(Return), MaxSize,
- Size2, Size, MaxDepth, Depth1, ReturnStr),
+ browser_term_to_string_2(BrowserDb, plain_term(Return),
+ MaxSize, Size2, Size, MaxDepth, Depth1,
+ ReturnStr),
string__append_list([Functor, BracketedArgsStr,
" = ", ReturnStr], Str)
;
@@ -715,20 +722,20 @@
)
).
-:- pred list_tail_to_string_list(univ::in, int::in, int::in, int::out, int::in,
- int::in, list(string)::out) is cc_multi.
+:- pred list_tail_to_string_list(browser_db::in, univ::in,
+ int::in, int::in, int::out, int::in, int::in, list(string)::out)
+ is cc_multi.
-list_tail_to_string_list(TailUniv, MaxSize, Size0, Size, MaxDepth, Depth0,
- TailStrs) :-
+list_tail_to_string_list(BrowserDb, TailUniv, MaxSize, Size0, Size,
+ MaxDepth, Depth0, TailStrs) :-
% We want the limit to be at least two to ensure that the limited
% deconstruct won't fail for any list term.
Limit = max(MaxSize, 2),
- limited_deconstruct_browser_term_cc(plain_term(TailUniv),
- Limit, MaybeFunctorArityArgs, MaybeReturn),
+ limited_deconstruct_browser_term_cc(BrowserDb, plain_term(TailUniv),
+ Limit, MaybeFunctorArityArgs, MaybeReturn),
(
- MaybeFunctorArityArgs = yes({Functor, _Arity, Args})
- ->
+ MaybeFunctorArityArgs = yes({Functor, _Arity, Args}),
(
Functor = "[]",
Args = [],
@@ -745,11 +752,12 @@
Size0 < MaxSize,
Depth0 < MaxDepth
->
- browser_term_to_string_2(plain_term(ListHead),
- MaxSize, Size0, Size1, MaxDepth, Depth0,
- HeadStr),
- list_tail_to_string_list(ListTail, MaxSize,
- Size1, Size, MaxDepth, Depth0,
+ browser_term_to_string_2(BrowserDb,
+ plain_term(ListHead),
+ MaxSize, Size0, Size1,
+ MaxDepth, Depth0, HeadStr),
+ list_tail_to_string_list(BrowserDb, ListTail,
+ MaxSize, Size1, Size, MaxDepth, Depth0,
TailStrs0),
TailStrs = [", ", HeadStr | TailStrs0]
;
@@ -761,35 +769,40 @@
Size0 < MaxSize,
Depth0 < MaxDepth
->
- browser_term_to_string_3(Functor, Args,
- MaybeReturn, MaxSize, Size0, Size,
+ browser_term_to_string_3(BrowserDb,
+ Functor, Args, MaybeReturn,
+ MaxSize, Size0, Size,
MaxDepth, Depth0, TailStr),
TailStrs = [" | ", TailStr]
;
Size = Size0,
- browser_term_compress(plain_term(TailUniv),
+ browser_term_compress(BrowserDb,
+ plain_term(TailUniv),
TailCompressedStr),
TailStrs = [" | ", TailCompressedStr]
)
)
;
+ MaybeFunctorArityArgs = no,
Size = Size0,
- browser_term_compress(plain_term(TailUniv), TailCompressedStr),
+ browser_term_compress(BrowserDb, plain_term(TailUniv),
+ TailCompressedStr),
TailStrs = [" | ", TailCompressedStr]
).
-:- pred args_to_string_list(list(univ)::in, int::in, int::in, int::out,
- int::in, int::in, list(string)::out) is cc_multi.
+:- pred args_to_string_list(browser_db::in, list(univ)::in,
+ int::in, int::in, int::out, int::in, int::in, list(string)::out)
+ is cc_multi.
-args_to_string_list([], _MaxSize, CurSize, NewSize,
+args_to_string_list(_BrowserDb, [], _MaxSize, CurSize, NewSize,
_MaxDepth, _CurDepth, Strs) :-
Strs = [],
NewSize = CurSize.
-args_to_string_list([Univ | Univs], MaxSize, CurSize, NewSize,
+args_to_string_list(BrowserDb, [Univ | Univs], MaxSize, CurSize, NewSize,
MaxDepth, CurDepth, Strs) :-
- browser_term_to_string_2(plain_term(Univ), MaxSize, CurSize, NewSize1,
- MaxDepth, CurDepth, Str),
- args_to_string_list(Univs, MaxSize, NewSize1, NewSize,
+ browser_term_to_string_2(BrowserDb, plain_term(Univ),
+ MaxSize, CurSize, NewSize1, MaxDepth, CurDepth, Str),
+ args_to_string_list(BrowserDb, Univs, MaxSize, NewSize1, NewSize,
MaxDepth, CurDepth, RestStrs),
Strs = [Str | RestStrs].
@@ -817,10 +830,11 @@
string__append_list([S1, ", ", Rest], Str)
).
-:- pred browser_term_compress(browser_term::in, string::out) is cc_multi.
+:- pred browser_term_compress(browser_db::in, browser_term::in, string::out)
+ is cc_multi.
-browser_term_compress(BrowserTerm, Str) :-
- functor_browser_term_cc(BrowserTerm, Functor, Arity, IsFunc),
+browser_term_compress(BrowserDb, BrowserTerm, Str) :-
+ functor_browser_term_cc(BrowserDb, BrowserTerm, Functor, Arity, IsFunc),
( Arity = 0 ->
Str = Functor
;
@@ -859,24 +873,25 @@
% Numbering makes it easier to change to subterms.
%
-:- pred browser_term_to_string_verbose(browser_term::in, int::in, int::in,
- int::in, int::in, string::out) is cc_multi.
+:- pred browser_term_to_string_verbose(browser_db::in, browser_term::in,
+ int::in, int::in, int::in, int::in, string::out) is cc_multi.
-browser_term_to_string_verbose(BrowserTerm, MaxSize, MaxDepth, X, Y, Str) :-
+browser_term_to_string_verbose(BrowserDb, BrowserTerm, MaxSize, MaxDepth,
+ X, Y, Str) :-
CurSize = 0,
CurDepth = 0,
- browser_term_to_string_verbose_2(BrowserTerm, MaxSize, CurSize,
- _NewSize, MaxDepth, CurDepth, Frame),
+ browser_term_to_string_verbose_2(BrowserDb, BrowserTerm,
+ MaxSize, CurSize, _NewSize, MaxDepth, CurDepth, Frame),
frame__clip(X-Y, Frame, ClippedFrame),
unlines(ClippedFrame, Str).
-:- pred browser_term_to_string_verbose_2(browser_term::in, int::in, int::in,
- int::out, int::in, int::in, frame::out) is cc_multi.
+:- pred browser_term_to_string_verbose_2(browser_db::in, browser_term::in,
+ int::in, int::in, int::out, int::in, int::in, frame::out) is cc_multi.
-browser_term_to_string_verbose_2(BrowserTerm, MaxSize, CurSize, NewSize,
- MaxDepth, CurDepth, Frame) :-
- limited_deconstruct_browser_term_cc(BrowserTerm, MaxSize,
- MaybeFunctorArityArgs, MaybeReturn),
+browser_term_to_string_verbose_2(BrowserDb, BrowserTerm,
+ MaxSize, CurSize, NewSize, MaxDepth, CurDepth, Frame) :-
+ limited_deconstruct_browser_term_cc(BrowserDb, BrowserTerm, MaxSize,
+ MaybeFunctorArityArgs, MaybeReturn),
(
CurSize < MaxSize,
CurDepth < MaxDepth,
@@ -893,36 +908,39 @@
CurSize1 = CurSize + 1,
CurDepth1 = CurDepth + 1,
ArgNum = 1,
- args_to_string_verbose_list(Args, ArgNum, MaxSize, CurSize1,
- NewSize, MaxDepth, CurDepth1, ArgsFrame),
+ args_to_string_verbose_list(BrowserDb, Args, ArgNum,
+ MaxSize, CurSize1, NewSize, MaxDepth, CurDepth1,
+ ArgsFrame),
frame__vglue([Functor], ArgsFrame, Frame)
;
- browser_term_compress(BrowserTerm, Line),
+ browser_term_compress(BrowserDb, BrowserTerm, Line),
Frame = [Line],
NewSize = CurSize
).
-:- pred args_to_string_verbose_list(list(univ)::in, int::in, int::in,
- int::in, int::out, int::in, int::in, frame::out) is cc_multi.
+:- pred args_to_string_verbose_list(browser_db::in, list(univ)::in,
+ int::in, int::in, int::in, int::out, int::in, int::in, frame::out)
+ is cc_multi.
-args_to_string_verbose_list([], _ArgNum, _MaxSize, CurSize, NewSize,
- _MaxDepth, _CurDepth, []) :-
+args_to_string_verbose_list(_BrowserDb, [], _ArgNum,
+ _MaxSize, CurSize, NewSize, _MaxDepth, _CurDepth, []) :-
NewSize = CurSize.
-args_to_string_verbose_list([Univ], ArgNum, MaxSize, CurSize, NewSize,
- MaxDepth, CurDepth, Frame) :-
- browser_term_to_string_verbose_2(plain_term(Univ), MaxSize,
+args_to_string_verbose_list(BrowserDb, [Univ], ArgNum,
+ MaxSize, CurSize, NewSize, MaxDepth, CurDepth, Frame) :-
+ browser_term_to_string_verbose_2(BrowserDb, plain_term(Univ), MaxSize,
CurSize, NewSize, MaxDepth, CurDepth, TreeFrame),
% XXX: ArgNumS must have fixed length 2.
string__int_to_string(ArgNum, ArgNumS),
string__append_list([ArgNumS, "-"], LastBranchS),
frame__hglue([LastBranchS], TreeFrame, Frame).
-args_to_string_verbose_list([Univ1, Univ2 | Univs], ArgNum, MaxSize,
+args_to_string_verbose_list(BrowserDb, [Univ1, Univ2 | Univs], ArgNum, MaxSize,
CurSize, NewSize, MaxDepth, CurDepth, Frame) :-
- browser_term_to_string_verbose_2(plain_term(Univ1), MaxSize, CurSize,
- NewSize1, MaxDepth, CurDepth, TreeFrame),
+ browser_term_to_string_verbose_2(BrowserDb, plain_term(Univ1),
+ MaxSize, CurSize, NewSize1, MaxDepth, CurDepth, TreeFrame),
ArgNum1 = ArgNum + 1,
- args_to_string_verbose_list([Univ2 | Univs], ArgNum1, MaxSize,
- NewSize1, NewSize2, MaxDepth, CurDepth, RestTreesFrame),
+ args_to_string_verbose_list(BrowserDb, [Univ2 | Univs], ArgNum1,
+ MaxSize, NewSize1, NewSize2, MaxDepth, CurDepth,
+ RestTreesFrame),
NewSize = NewSize2,
% XXX: ArgNumS must have fixed length 2.
string__int_to_string(ArgNum, ArgNumS),
Index: browser/browse_test.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/browse_test.m,v
retrieving revision 1.3
diff -u -r1.3 browse_test.m
--- browser/browse_test.m 4 Feb 2000 03:45:25 -0000 1.3
+++ browser/browse_test.m 26 Jul 2003 19:55:19 -0000
@@ -16,42 +16,54 @@
:- import_module io.
:- pred main(io__state, io__state).
-:- mode main(di, uo) is det.
+:- mode main(di, uo) is cc_multi.
:- implementation.
+:- import_module mdb.
+:- import_module mdb__browse.
+:- import_module mdb__browser_info.
+
:- import_module list, string, int, std_util, tree234, assoc_list.
-:- import_module mdb, mdb__browse.
main -->
- { Filename = "/etc/hosts" },
+ { Filename = "/etc/fstab" },
{ EXIT_FAILURE = 1 },
{ EXIT_SUCCESS = 0 },
- io__see(Filename, Result),
- ( { Result = error(_) } ->
- io__write_string("Can't open input file.\n"),
- io__set_exit_status(EXIT_FAILURE)
- ;
- read_words(Words),
- io__seen,
+ io__open_input(Filename, Result),
+ ( { Result = ok(WordsStream) } ->
+ read_words(WordsStream, Words),
+ io__close_input(WordsStream),
{ assoc_list__from_corresponding_lists(Words, Words,
AssocList) },
{ tree234__assoc_list_to_tree234(AssocList, Tree) },
io__stdin_stream(StdIn),
io__stdout_stream(StdOut),
- browse__init_state(State),
- browse__browse(Tree, StdIn, StdOut, State, _),
+ { browser_info__init_persistent_state(State0) },
+ io__write_string("list:"),
+ io__nl,
+ browse__browse(AssocList, StdIn, StdOut, _, State0, State1),
+ io__write_string("tree:"),
+ io__nl,
+ browse__browse(Tree, StdIn, StdOut, _, State1, State2),
+ io__write_string("stream:"),
+ io__nl,
+ browse__browse(StdIn, StdIn, StdOut, _, State2, _),
io__set_exit_status(EXIT_SUCCESS)
+ ;
+ io__write_string("Can't open input file.\n"),
+ io__set_exit_status(EXIT_FAILURE)
).
-:- pred read_words(list(string), io__state, io__state).
-:- mode read_words(out, di, uo) is det.
-read_words(Words) -->
- io__read_word(Result),
+:- pred read_words(io__input_stream::in, list(string)::out,
+ io__state::di, io__state::uo) is det.
+
+read_words(Stream, Words) -->
+ io__read_word(Stream, Result),
( { Result = ok(Chars) } ->
{ string__from_char_list(Chars, Word) },
- read_words(Rest),
- { Words = [Word|Rest] }
+ read_words(Stream, Rest),
+ { Words = [Word | Rest] }
;
{ Words = [] }
).
Index: browser/browser_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/browser_info.m,v
retrieving revision 1.11
diff -u -r1.11 browser_info.m
--- browser/browser_info.m 3 Dec 2002 10:21:16 -0000 1.11
+++ browser/browser_info.m 27 Jul 2003 08:04:32 -0000
@@ -13,7 +13,7 @@
:- module mdb__browser_info.
:- interface.
-:- import_module bool, list, std_util.
+:- import_module bool, list, std_util, io.
:- type browser_term
---> plain_term(
@@ -155,26 +155,35 @@
%---------------------------------------------------------------------------%
% These three predicates are like the deconstruct, limited_deconstruct
-% and functor procedures in deconstruct, except they implicitly specify
-% include_details_cc and they work on browser_terms instead of plain terms.
+% and functor procedures in deconstruct, except
+%
+% - they implicitly specify include_details_cc, and
+% - they work on browser_terms instead of plain terms.
+%
% The latter difference requires them to have an extra argument (the last).
% For deconstruct and limited_deconstruct, this returns the return value
% if the browser term represents a function call. For functor, it says
% whether the browser term represents a function call.
-:- pred deconstruct_browser_term_cc(browser_term::in,
+:- type browser_db
+ ---> browser_db(
+ browser_stream_db :: io__stream_db
+ ).
+
+:- pred deconstruct_browser_term_cc(browser_db::in, browser_term::in,
string::out, int::out, list(univ)::out, maybe(univ)::out) is cc_multi.
-:- pred limited_deconstruct_browser_term_cc(browser_term::in, int::in,
- maybe({string, int, list(univ)})::out, maybe(univ)::out) is cc_multi.
+:- pred limited_deconstruct_browser_term_cc(browser_db::in, browser_term::in,
+ int::in, maybe({string, int, list(univ)})::out, maybe(univ)::out)
+ is cc_multi.
-:- pred functor_browser_term_cc(browser_term::in, string::out, int::out,
- bool::out) is cc_multi.
+:- pred functor_browser_term_cc(browser_db::in, browser_term::in, string::out,
+ int::out, bool::out) is cc_multi.
%---------------------------------------------------------------------------%
:- implementation.
-:- import_module deconstruct, require.
+:- import_module deconstruct, require, io.
:- pragma export(browser_info__init_persistent_state(out),
"ML_BROWSE_init_persistent_state").
@@ -501,22 +510,25 @@
%---------------------------------------------------------------------------%
-deconstruct_browser_term_cc(BrowserTerm, Functor, Arity, Args, MaybeReturn) :-
+deconstruct_browser_term_cc(BrowserDb, BrowserTerm, Functor, Arity,
+ Args, MaybeReturn) :-
(
BrowserTerm = plain_term(Univ),
- deconstruct_cc(univ_value(Univ), Functor, Arity, Args),
+ deconstruct__deconstruct(pretty_value(BrowserDb, Univ),
+ include_details_cc, Functor, Arity, Args),
MaybeReturn = no
;
BrowserTerm = synthetic_term(Functor, Args, MaybeReturn),
list__length(Args, Arity)
).
-limited_deconstruct_browser_term_cc(BrowserTerm, Limit, MaybeFunctorArityArgs,
- MaybeReturn) :-
+limited_deconstruct_browser_term_cc(BrowserDb, BrowserTerm, Limit,
+ MaybeFunctorArityArgs, MaybeReturn) :-
(
BrowserTerm = plain_term(Univ),
- std_util__limited_deconstruct_cc(univ_value(Univ), Limit,
- MaybeFunctorArityArgs),
+ deconstruct__limited_deconstruct_cc(
+ pretty_value(BrowserDb, Univ), Limit,
+ MaybeFunctorArityArgs),
MaybeReturn = no
;
BrowserTerm = synthetic_term(Functor, Args, MaybeReturn),
@@ -524,10 +536,11 @@
MaybeFunctorArityArgs = yes({Functor, Arity, Args})
).
-functor_browser_term_cc(BrowserTerm, Functor, Arity, IsFunc) :-
+functor_browser_term_cc(BrowserDb, BrowserTerm, Functor, Arity, IsFunc) :-
(
BrowserTerm = plain_term(Univ),
- functor(univ_value(Univ), include_details_cc, Functor, Arity),
+ deconstruct__functor(pretty_value(BrowserDb, Univ),
+ include_details_cc, Functor, Arity),
IsFunc = no
;
BrowserTerm = synthetic_term(Functor, Args, MaybeReturn),
@@ -540,5 +553,29 @@
IsFunc = no
)
).
+
+:- some [T] func pretty_value(browser_db, univ) = T.
+
+pretty_value(BrowserDb, Univ0) = Value :-
+ ( univ_to_type(Univ0, InputStream) ->
+ io__input_stream_info(BrowserDb ^ browser_stream_db,
+ InputStream) = InputStreamInfo,
+ type_to_univ(InputStreamInfo, Univ)
+ ; univ_to_type(Univ0, OutputStream) ->
+ io__output_stream_info(BrowserDb ^ browser_stream_db,
+ OutputStream) = OutputStreamInfo,
+ type_to_univ(OutputStreamInfo, Univ)
+ ; univ_to_type(Univ0, BinaryInputStream) ->
+ io__binary_input_stream_info(BrowserDb ^ browser_stream_db,
+ BinaryInputStream) = BinaryInputStreamInfo,
+ type_to_univ(BinaryInputStreamInfo, Univ)
+ ; univ_to_type(Univ0, BinaryOutputStream) ->
+ io__binary_output_stream_info(BrowserDb ^ browser_stream_db,
+ BinaryOutputStream) = BinaryOutputStreamInfo,
+ type_to_univ(BinaryOutputStreamInfo, Univ)
+ ;
+ Univ = Univ0
+ ),
+ Value = univ_value(Univ).
%---------------------------------------------------------------------------%
Index: browser/sized_pretty.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/sized_pretty.m,v
retrieving revision 1.7
diff -u -r1.7 sized_pretty.m
--- browser/sized_pretty.m 3 Dec 2002 10:21:17 -0000 1.7
+++ browser/sized_pretty.m 27 Jul 2003 08:00:51 -0000
@@ -168,13 +168,13 @@
% Converts the term in Univ to a string that fits into Lines lines
% of width LineWidth. It may throw an exception or cause a runtime
% abort if the term in question has no canonical representation.
-:- pred sized_pretty__univ_to_string_line(univ::in, int::in, int::in,
- string::out) is cc_multi.
+:- pred sized_pretty__univ_to_string_line(browser_db::in, univ::in,
+ int::in, int::in, string::out) is cc_multi.
% The same as sized_pretty__univ_to_string_line, except works on
% browser_terms.
-:- pred sized_pretty__browser_term_to_string_line(browser_term::in,
- int::in, int::in, string::out) is cc_multi.
+:- pred sized_pretty__browser_term_to_string_line(browser_db::in,
+ browser_term::in, int::in, int::in, string::out) is cc_multi.
%---------------------------------------------------------------------------%
@@ -247,9 +247,9 @@
% each argument,
% - adjusted measurement of available space,
% - adjusted measure parameter(s).
- pred measured_split(browser_term::in, MeasureParams::in, T::in,
- int::in, bool::in, T::out, maybe(T)::out, T::out,
- MeasureParams::out) is cc_multi
+ pred measured_split(browser_db::in, browser_term::in,
+ MeasureParams::in, T::in, int::in, bool::in, T::out,
+ maybe(T)::out, T::out, MeasureParams::out) is cc_multi
].
%---------------------------------------------------------------------------%
@@ -263,14 +263,15 @@
% given a limit of character_count(LineWidth - 1) instead of
% character_count(LineWidth - 3).
-sized_pretty__univ_to_string_line(Univ, LineWidth, Lines, String) :-
- sized_pretty__browser_term_to_string_line(plain_term(Univ),
+sized_pretty__univ_to_string_line(BrowserDb, Univ, LineWidth, Lines, String) :-
+ sized_pretty__browser_term_to_string_line(BrowserDb, plain_term(Univ),
LineWidth, Lines, String).
-sized_pretty__browser_term_to_string_line(BrowserTerm, LineWidth, Lines,
- String) :-
+sized_pretty__browser_term_to_string_line(BrowserDb, BrowserTerm,
+ LineWidth, Lines, String) :-
Params = measure_params(LineWidth),
- functor_browser_term_cc(BrowserTerm, _Functor, Arity, _MaybeReturn),
+ functor_browser_term_cc(BrowserDb, BrowserTerm,
+ _Functor, Arity, _MaybeReturn),
(
Arity \= 0,
Lines \= 0,
@@ -281,7 +282,7 @@
;
Limit = line_count(Lines)
),
- annotate_with_size(BrowserTerm, Params, Limit, AnnotTerm),
+ annotate_with_size(BrowserDb, BrowserTerm, Params, Limit, AnnotTerm),
Doc = to_doc_sized(AnnotTerm),
String = pprint__to_string(LineWidth, Doc).
@@ -293,36 +294,36 @@
% further.
% In the Second pass the space is evenly distributed between
% the terms and therefore the subterms are deconstructed evenly.
-:- pred annotate_with_size(browser_term::in, MeasureParams::in, T::in,
- size_annotated_term(T)::out) is cc_multi
+:- pred annotate_with_size(browser_db::in, browser_term::in, MeasureParams::in,
+ T::in, size_annotated_term(T)::out) is cc_multi
<= measure_with_params(T, MeasureParams).
-annotate_with_size(BrowserTerm, Params, Limit, SizedTerm2) :-
- first_pass(BrowserTerm, Params, Limit, SizedTerm1),
- second_pass(SizedTerm1, Params, Limit, SizedTerm2).
+annotate_with_size(BrowserDb, BrowserTerm, Params, Limit, SizedTerm2) :-
+ first_pass(BrowserDb, BrowserTerm, Params, Limit, SizedTerm1),
+ second_pass(BrowserDb, SizedTerm1, Params, Limit, SizedTerm2).
%---------------------------------------------------------------------------%
-:- pred first_pass(browser_term::in, MeasureParams::in, T::in,
+:- pred first_pass(browser_db::in, browser_term::in, MeasureParams::in, T::in,
size_annotated_term(T)::out) is cc_multi
<= measure_with_params(T, MeasureParams).
-first_pass(BrowserTerm, Params, Limit, Size) :-
+first_pass(BrowserDb, BrowserTerm, Params, Limit, Size) :-
MaxFunctors = maximum_functors(Limit, Params),
- limited_deconstruct_browser_term_cc(BrowserTerm, MaxFunctors,
- MaybeFunctorArityArgs, _MaybeReturn),
+ limited_deconstruct_browser_term_cc(BrowserDb, BrowserTerm,
+ MaxFunctors, MaybeFunctorArityArgs, _MaybeReturn),
(
- MaybeFunctorArityArgs = yes({Functor, Arity, Args})
- ->
- measured_split(BrowserTerm, Params, Limit, Arity, yes,
- FunctorSize, MaybeInitArgLimit, NewLimit, NewParams),
+ MaybeFunctorArityArgs = yes({Functor, Arity, Args}),
+ measured_split(BrowserDb, BrowserTerm, Params, Limit,
+ Arity, yes, FunctorSize, MaybeInitArgLimit,
+ NewLimit, NewParams),
( (Arity \= 0, MaybeInitArgLimit = no) ->
Exact0 = no
;
Exact0 = yes
),
- annotate_args_with_size(Args, MaybeInitArgLimit, NewParams,
- NewLimit, FunctorSize, SoFar, Exact0, Exact,
+ annotate_args_with_size(BrowserDb, Args, MaybeInitArgLimit,
+ NewParams, NewLimit, FunctorSize, SoFar, Exact0, Exact,
MaybeArgSizes),
(
Exact = no,
@@ -334,20 +335,21 @@
MaybeArgSizes)
)
;
+ MaybeFunctorArityArgs = no,
Size = at_least(BrowserTerm, zero_measure, not_deconstructed)
).
%---------------------------------------------------------------------------%
% annotating the arguments.
-:- pred annotate_args_with_size(list(univ)::in, maybe(T)::in,
+:- pred annotate_args_with_size(browser_db::in, list(univ)::in, maybe(T)::in,
MeasureParams::in, T::in, T::in, T::out, bool::in, bool::out,
size_annotated_args(T)::out) is cc_multi <= measure_with_params(T,
MeasureParams).
-annotate_args_with_size([], _, _, _, SoFar, SoFar, Exact, Exact, []).
-annotate_args_with_size([Arg | Args], MaybeInitArgLimit, Params, Limit,
- SoFar0, SoFar, Exact0, Exact,
+annotate_args_with_size(_, [], _, _, _, SoFar, SoFar, Exact, Exact, []).
+annotate_args_with_size(BrowserDb, [Arg | Args], MaybeInitArgLimit, Params,
+ Limit, SoFar0, SoFar, Exact0, Exact,
[MaybeArgSize | MaybeArgSizes]) :-
(
MaybeInitArgLimit = yes(InitArgLimit),
@@ -357,7 +359,8 @@
AppliedArgLimit = max_measure(InitArgLimit,
subtract_measures(Limit, SoFar0, Params))
),
- first_pass(plain_term(Arg), Params, AppliedArgLimit, Size),
+ first_pass(BrowserDb, plain_term(Arg), Params,
+ AppliedArgLimit, Size),
MaybeArgSize = yes(InitArgLimit - Size),
extract_size_from_annotation(Size) = ArgSize,
SoFar1 = add_measures(SoFar0, ArgSize, Params),
@@ -379,8 +382,8 @@
;
Exact2 = Exact1
),
- annotate_args_with_size(Args, MaybeInitArgLimit, Params, Limit,
- SoFar1, SoFar, Exact2, Exact, MaybeArgSizes).
+ annotate_args_with_size(BrowserDb, Args, MaybeInitArgLimit, Params,
+ Limit, SoFar1, SoFar, Exact2, Exact, MaybeArgSizes).
%---------------------------------------------------------------------------%
@@ -407,11 +410,11 @@
% the other terms which could take up more than their share.
% If a term can be fully printed within the given space,
% ("exact" type) then the Term is not altered.
-:- pred second_pass(size_annotated_term(T)::in, MeasureParams::in, T::in,
- size_annotated_term(T)::out) is cc_multi
+:- pred second_pass(browser_db::in, size_annotated_term(T)::in,
+ MeasureParams::in, T::in, size_annotated_term(T)::out) is cc_multi
<= measure_with_params(T, MeasureParams).
-second_pass(OldSizeTerm, Params, Limit, NewSizeTerm) :-
+second_pass(BrowserDb, OldSizeTerm, Params, Limit, NewSizeTerm) :-
(
OldSizeTerm = exact(_BrowserTerm, _Size, _,
_Arity, _MaybeArgs),
@@ -422,18 +425,20 @@
;
OldSizeTerm = at_least(BrowserTerm, _Size,
deconstructed(Functor, Arity,MaybeArgs)),
- measured_split(BrowserTerm, Params, Limit, Arity, yes, FSize,
- MaybeInitLimit, NewLimit, NewParams),
+ measured_split(BrowserDb, BrowserTerm, Params, Limit, Arity,
+ yes, FSize, MaybeInitLimit, NewLimit, NewParams),
( MaybeInitLimit = yes(InitLimit) ->
check_args(NewParams, MaybeArgs, InitLimit, Passed,
FSize, Used),
LeftOver = add_measures(subtract_measures(NewLimit,
Used, Params), FSize, Params),
- measured_split(BrowserTerm, Params, LeftOver,
- Arity - Passed, no, _, MaybeSplitLimit, _, _),
+ measured_split(BrowserDb, BrowserTerm, Params,
+ LeftOver, Arity - Passed, no, _,
+ MaybeSplitLimit, _, _),
( MaybeSplitLimit = yes(SplitLimit) ->
- process_args(NewParams, MaybeArgs, InitLimit,
- SplitLimit, NewArgs, NewSize0),
+ process_args(BrowserDb, NewParams, MaybeArgs,
+ InitLimit, SplitLimit,
+ NewArgs, NewSize0),
NewSize = add_measures(FSize, NewSize0,
NewParams),
Result0 = list__map(check_if_exact, NewArgs),
@@ -499,12 +504,12 @@
% but the terms which do not obey the limit or not fully
% represented would be annoted again with a new limit
% (SplitLimit). The rest of the terms are left alone.
-:- pred process_args(MeasureParams::in, size_annotated_args(T)::in, T::in,
- T::in, size_annotated_args(T)::out, T::out) is cc_multi <=
- measure_with_params(T, MeasureParams).
+:- pred process_args(browser_db::in, MeasureParams::in,
+ size_annotated_args(T)::in, T::in, T::in, size_annotated_args(T)::out,
+ T::out) is cc_multi <= measure_with_params(T, MeasureParams).
-process_args(_, [], _, _, [], zero_measure).
-process_args(Params, [HeadArg | Rest], ArgLimit, SplitLimit,
+process_args(_, _, [], _, _, [], zero_measure).
+process_args(BrowserDb, Params, [HeadArg | Rest], ArgLimit, SplitLimit,
[NewHeadArg | NewRest], SizeOut) :-
( HeadArg = yes(X) ->
X = _ - STerm,
@@ -521,8 +526,8 @@
NewHeadArg = HeadArg
;
NewHeadArg = yes(pair(SplitLimit, NewSTerm)),
- annotate_with_size(BrowserTerm, Params, SplitLimit,
- NewSTerm)
+ annotate_with_size(BrowserDb, BrowserTerm, Params,
+ SplitLimit, NewSTerm)
)
;
NewHeadArg = no
@@ -533,7 +538,8 @@
;
SizeOut = RestSize
),
- process_args(Params, Rest, ArgLimit, SplitLimit, NewRest, RestSize).
+ process_args(BrowserDb, Params, Rest, ArgLimit, SplitLimit,
+ NewRest, RestSize).
%---------------------------------------------------------------------------%
@@ -642,12 +648,12 @@
zero_functor_count = functor_count(0).
-:- pred functor_count_split(browser_term::in, no_measure_params::in,
- functor_count::in, int::in, bool::in, functor_count::out,
- maybe(functor_count)::out, functor_count::out, no_measure_params::out)
- is cc_multi.
+:- pred functor_count_split(browser_db::in, browser_term::in,
+ no_measure_params::in, functor_count::in, int::in, bool::in,
+ functor_count::out, maybe(functor_count)::out, functor_count::out,
+ no_measure_params::out) is cc_multi.
-functor_count_split(_, Params, functor_count(Limit), Arity, _,
+functor_count_split(_, _, Params, functor_count(Limit), Arity, _,
functor_count(1), MaybeArgLimit, functor_count(Limit),
Params) :-
( Arity = 0 ->
@@ -674,7 +680,7 @@
func(add_measures/3) is add_functor_count,
func(subtract_measures/3) is subtract_functor_count,
func(maximum_functors/2) is maximum_functor_count,
- pred(measured_split/9) is functor_count_split
+ pred(measured_split/10) is functor_count_split
].
%---------------------------------------------------------------------------%
@@ -715,15 +721,15 @@
zero_char_count = char_count(0).
-:- pred char_count_split(browser_term::in, no_measure_params::in,
- char_count::in, int::in, bool::in, char_count::out,
- maybe(char_count)::out, char_count::out, no_measure_params::out)
- is cc_multi.
-
-char_count_split(BrowserTerm, Params, char_count(Limit), Arity, Check,
- char_count(FunctorSize), MaybeArgLimit, char_count(Limit),
- Params) :-
- deconstruct_browser_term_cc(BrowserTerm, Functor, _, Args,
+:- pred char_count_split(browser_db::in, browser_term::in,
+ no_measure_params::in, char_count::in, int::in, bool::in,
+ char_count::out, maybe(char_count)::out, char_count::out,
+ no_measure_params::out) is cc_multi.
+
+char_count_split(BrowserDb, BrowserTerm, Params, char_count(Limit), Arity,
+ Check, char_count(FunctorSize), MaybeArgLimit,
+ char_count(Limit), Params) :-
+ deconstruct_browser_term_cc(BrowserDb, BrowserTerm, Functor, _, Args,
MaybeReturn),
( Check = yes ->
get_arg_length(Args, TotalLength, _)
@@ -760,7 +766,7 @@
func(add_measures/3) is add_char_count,
func(subtract_measures/3) is subtract_char_count,
func(maximum_functors/2) is maximum_char_count,
- pred(measured_split/9) is char_count_split
+ pred(measured_split/10) is char_count_split
].
%---------------------------------------------------------------------------%
@@ -887,16 +893,17 @@
% We assume that all arguments have to be on separate lines, or
% the whole term should be printed on a single line.
-:- pred size_count_split(browser_term::in, measure_params::in, size_count::in,
- int::in, bool::in, size_count::out, maybe(size_count)::out,
- size_count::out, measure_params::out) is cc_multi.
+:- pred size_count_split(browser_db::in, browser_term::in, measure_params::in,
+ size_count::in, int::in, bool::in, size_count::out,
+ maybe(size_count)::out, size_count::out, measure_params::out)
+ is cc_multi.
-size_count_split(BrowserTerm, Params, Limit, Arity, Check, FunctorSize,
- MaybeArgLimit, NewLimit, NewParams) :-
+size_count_split(BrowserDb, BrowserTerm, Params, Limit, Arity, Check,
+ FunctorSize, MaybeArgLimit, NewLimit, NewParams) :-
% LineWidth is length of the line in which the functor is printed.
Params = measure_params(LineWidth),
- deconstruct_browser_term_cc(BrowserTerm, Functor, ActualArity, Args,
- MaybeReturn),
+ deconstruct_browser_term_cc(BrowserDb, BrowserTerm,
+ Functor, ActualArity, Args, MaybeReturn),
FSize = string__length(Functor) + 2 * (ActualArity),
( Check = yes ->
get_arg_length(Args, TotalLength, MaxArgLength),
@@ -985,7 +992,7 @@
func(add_measures/3) is add_size_count,
func(subtract_measures/3) is subtract_size_count,
func(maximum_functors/2) is maximum_size_count,
- pred(measured_split/9) is size_count_split
+ pred(measured_split/10) is size_count_split
].
%---------------------------------------------------------------------------%
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.303
diff -u -r1.303 io.m
--- library/io.m 28 Aug 2003 06:56:50 -0000 1.303
+++ library/io.m 4 Sep 2003 09:40:42 -0000
@@ -24,7 +24,7 @@
:- module io.
:- interface.
-:- import_module bool, char, string, std_util, list, time, deconstruct.
+:- import_module bool, char, string, std_util, list, map, time, deconstruct.
%-----------------------------------------------------------------------------%
@@ -61,6 +61,41 @@
:- type io__binary_stream.
+:- type stream_mode ---> input
+ ; output
+ ; append.
+
+:- type stream_content ---> text
+ ; binary
+ ; preopen.
+
+:- type stream_source ---> file(string) % the file name
+ ; stdin
+ ; stdout
+ ; stderr.
+
+:- type stream_info
+ ---> stream(
+ stream_id :: int,
+ stream_mode :: stream_mode,
+ stream_content :: stream_content,
+ stream_source :: stream_source
+ ).
+
+:- type maybe_stream_info
+ ---> stream(
+ maybe_stream_id :: int,
+ maybe_stream_mode :: stream_mode,
+ maybe_stream_content :: stream_content,
+ maybe_stream_source :: stream_source
+ )
+ ; unknown_stream.
+
+ % a unique identifier for an IO stream
+:- type io__stream_id.
+
+:- type io__stream_db == map(io__stream_id, stream_info).
+
% Various types used for the result from the access predicates
:- type io__res ---> ok
@@ -1084,6 +1119,35 @@
%-----------------------------------------------------------------------------%
+% Predicates for managing the stream info database.
+
+:- pred io__get_stream_db(io__stream_db::out, io__state::di, io__state::uo)
+ is det.
+% Retrieves the database mapping streams to the information we have
+% about those streams.
+
+:- func io__input_stream_info(io__stream_db, io__input_stream)
+ = io__maybe_stream_info.
+% Returns the information associated with the specified input
+% stream in the given stream database.
+
+:- func io__output_stream_info(io__stream_db, io__output_stream)
+ = io__maybe_stream_info.
+% Returns the information associated with the specified output
+% stream in the given stream database.
+
+:- func io__binary_input_stream_info(io__stream_db, io__binary_input_stream)
+ = io__maybe_stream_info.
+% Returns the information associated with the specified binary input
+% stream in the given stream database.
+
+:- func io__binary_output_stream_info(io__stream_db, io__binary_output_stream)
+ = io__maybe_stream_info.
+% Returns the information associated with the specified binary output
+% stream in the given stream database.
+
+%-----------------------------------------------------------------------------%
+
% Global state predicates.
:- pred io__progname(string, string, io__state, io__state).
@@ -1533,16 +1597,19 @@
% for cases such as `type_name(main)'.
:- pragma foreign_decl("C", "
- extern MR_Word ML_io_stream_names;
+ extern MR_Word ML_io_stream_db;
extern MR_Word ML_io_user_globals;
+ extern int ML_next_stream_id;
#if 0
extern MR_Word ML_io_ops_table;
#endif
").
:- pragma foreign_code("C", "
- MR_Word ML_io_stream_names;
+ MR_Word ML_io_stream_db;
MR_Word ML_io_user_globals;
+ /* a counter used to generate unique stream ids */
+ int ML_next_stream_id;
#if 0
MR_Word ML_io_ops_table;
#endif
@@ -1577,7 +1644,6 @@
").
-:- type io__stream_names == map(io__stream_id, string).
:- type io__stream_putback == map(io__stream_id, list(char)).
:- type io__input_stream == io__stream.
@@ -1585,24 +1651,15 @@
:- type io__binary_stream == io__stream.
-:- type io__stream == c_pointer.
+:- type io__stream ---> io__stream(c_pointer).
+:- pragma foreign_type("C", io__stream, "MercuryFilePtr").
+:- pragma foreign_type("il", io__stream, "class [mscorlib]System.Object[]").
% a unique identifier for an IO stream
:- type io__stream_id == int.
:- func io__get_stream_id(io__stream) = io__stream_id.
-/*
- * In NU-Prolog:
- * io__stream ---> stream(int, int)
- * ; user_input
- * ; user_output
- * ; user_error.
- * In C:
- * io__stream == pointer to MercuryFile (which is defined
- * in runtime/mercury_library_types.h)
- */
-
% This inter-language stuff is tricky.
% We communicate via ints rather than via io__result_codes because
% we don't want the C code to depend on how Mercury stores its
@@ -1632,18 +1689,6 @@
% Otherwise returns the raw exit status from the system()
% call.
-:- pred io__do_open_binary(string, string, int, io__input_stream,
- io__state, io__state).
-:- mode io__do_open_binary(in, in, out, out, di, uo) is det.
-:- pred io__do_open_text(string, string, int, io__input_stream,
- io__state, io__state).
-:- mode io__do_open_text(in, in, out, out, di, uo) is det.
-% io__do_open_binary(File, Mode, ResultCode, Stream, IO0, IO1):
-% io__do_open_text(File, Mode, ResultCode, Stream, IO0, IO1):
-% Attempts to open a file in the specified mode.
-% The Mode is a string suitable for passing to fopen().
-% Result is 0 for success, -1 for failure.
-
:- semipure pred io__getenv(string, string).
:- mode io__getenv(in, out) is semidet.
% io__getenv(Var, Value).
@@ -1843,7 +1888,7 @@
Res = 0;
for (i = 0; char_code != '\\n'; ) {
- char_code = mercury_getc((MercuryFile *) File);
+ char_code = mercury_getc(File);
if (char_code == EOF) {
if (i == 0) {
Res = -1;
@@ -2090,10 +2135,8 @@
io__clear_err(Stream::in, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *f = (MercuryFile *) Stream;
-
- if (MR_IS_FILE_STREAM(*f)) {
- clearerr(MR_file(*f));
+ if (MR_IS_FILE_STREAM(*Stream)) {
+ clearerr(MR_file(*Stream));
} else {
/* Not a file stream so do nothing */
}
@@ -2130,10 +2173,8 @@
ferror(Stream::in, RetVal::out, RetStr::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *f = (MercuryFile *) Stream;
-
- if (MR_IS_FILE_STREAM(*f)) {
- RetVal = ferror(MR_file(*f));
+ if (MR_IS_FILE_STREAM(*Stream)) {
+ RetVal = ferror(MR_file(*Stream));
} else {
RetVal = -1;
}
@@ -2263,20 +2304,20 @@
#ifdef MR_HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
-#include ""mercury_types.h"" /* for MR_Integer */
+#include ""mercury_types.h"" /* for MR_Integer */
+#include ""mercury_library_types.h"" /* for MercuryFilePtr */
").
:- pragma foreign_proc("C",
io__stream_file_size(Stream::in, Size::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *f = (MercuryFile *) Stream;
#if defined(MR_HAVE_FSTAT) && \
(defined(MR_HAVE_FILENO) || defined(fileno)) && \
defined(S_ISREG)
struct stat s;
- if (MR_IS_FILE_STREAM(*f)) {
- if (fstat(fileno(MR_file(*f)), &s) == 0 &&
+ if (MR_IS_FILE_STREAM(*Stream)) {
+ if (fstat(fileno(MR_file(*Stream)), &s) == 0 &&
S_ISREG(s.st_mode))
{
Size = s.st_size;
@@ -3051,13 +3092,12 @@
Size::in, Buffer::buffer_uo, Pos::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *f = (MercuryFile *) Stream;
- int items_read;
+ int items_read;
MR_CHECK_EXPR_TYPE(Buffer0, MR_Char *);
MR_CHECK_EXPR_TYPE(Buffer, MR_Char *);
- items_read = MR_READ(*f, Buffer0 + Pos0, Size - Pos0);
+ items_read = MR_READ(*Stream, Buffer0 + Pos0, Size - Pos0);
Buffer = Buffer0;
Pos = Pos0 + items_read;
@@ -3498,6 +3538,11 @@
io__write_type_desc(TypeDesc)
; { univ_to_type(Univ, TypeCtorDesc) } ->
io__write_type_ctor_desc(TypeCtorDesc)
+ ; { univ_to_type(Univ, Stream) } ->
+ io__get_stream_db(StreamDb),
+ { io__maybe_stream_info(StreamDb, Stream) = StreamInfo },
+ { type_to_univ(StreamInfo, StreamInfoUniv) },
+ io__do_write_univ(NonCanon, StreamInfoUniv, Priority)
; { univ_to_type(Univ, C_Pointer) } ->
io__write_c_pointer(C_Pointer)
;
@@ -3860,60 +3905,66 @@
% stream predicates
io__open_input(FileName, Result) -->
- io__do_open_text(FileName, "r", Result0, NewStream),
+ io__do_open_text(FileName, "r", Result0, OpenCount, NewStream),
( { Result0 \= -1 } ->
{ Result = ok(NewStream) },
- io__insert_stream_name(NewStream, FileName)
+ io__insert_stream_info(NewStream,
+ stream(OpenCount, input, text, file(FileName)))
;
io__make_err_msg("can't open input file: ", Msg),
{ Result = error(io_error(Msg)) }
).
io__open_output(FileName, Result) -->
- io__do_open_text(FileName, "w", Result0, NewStream),
+ io__do_open_text(FileName, "w", Result0, OpenCount, NewStream),
( { Result0 \= -1 } ->
{ Result = ok(NewStream) },
- io__insert_stream_name(NewStream, FileName)
+ io__insert_stream_info(NewStream,
+ stream(OpenCount, output, text, file(FileName)))
;
io__make_err_msg("can't open output file: ", Msg),
{ Result = error(io_error(Msg)) }
).
io__open_append(FileName, Result) -->
- io__do_open_text(FileName, "a", Result0, NewStream),
+ io__do_open_text(FileName, "a", Result0, OpenCount, NewStream),
( { Result0 \= -1 } ->
{ Result = ok(NewStream) },
- io__insert_stream_name(NewStream, FileName)
+ io__insert_stream_info(NewStream,
+ stream(OpenCount, append, text, file(FileName)))
;
io__make_err_msg("can't append to file: ", Msg),
{ Result = error(io_error(Msg)) }
).
io__open_binary_input(FileName, Result) -->
- io__do_open_binary(FileName, "rb", Result0, NewStream),
+ io__do_open_binary(FileName, "rb", Result0, OpenCount, NewStream),
( { Result0 \= -1 } ->
{ Result = ok(NewStream) },
- io__insert_stream_name(NewStream, FileName)
+ io__insert_stream_info(NewStream,
+ stream(OpenCount, input, binary, file(FileName)))
;
io__make_err_msg("can't open input file: ", Msg),
{ Result = error(io_error(Msg)) }
).
io__open_binary_output(FileName, Result) -->
- io__do_open_binary(FileName, "wb", Result0, NewStream),
+ io__do_open_binary(FileName, "wb", Result0, OpenCount, NewStream),
( { Result0 \= -1 } ->
{ Result = ok(NewStream) },
- io__insert_stream_name(NewStream, FileName)
+ io__insert_stream_info(NewStream,
+ stream(OpenCount, output, binary, file(FileName)))
;
io__make_err_msg("can't open output file: ", Msg),
{ Result = error(io_error(Msg)) }
).
io__open_binary_append(FileName, Result) -->
- io__do_open_binary(FileName, "ab", Result0, NewStream),
+ io__do_open_binary(FileName, "ab", Result0, OpenCount, NewStream),
( { Result0 \= -1 } ->
{ Result = ok(NewStream) },
- io__insert_stream_name(NewStream, FileName)
+ io__insert_stream_info(NewStream,
+ stream(OpenCount, append, binary, file(FileName)))
;
io__make_err_msg("can't append to file: ", Msg),
{ Result = error(io_error(Msg)) }
@@ -4030,67 +4081,146 @@
:- mode io__stream_name(in, out, di, uo) is det.
io__stream_name(Stream, Name) -->
- io__get_stream_names(StreamNames),
- { map__search(StreamNames, get_stream_id(Stream), Name1) ->
- Name = Name1
+ io__stream_info(Stream, MaybeInfo),
+ {
+ MaybeInfo = yes(Info),
+ Info = stream(_, _, _, Source),
+ Name = source_name(Source)
;
+ MaybeInfo = no,
Name = "<stream name unavailable>"
- },
- io__set_stream_names(StreamNames).
+ }.
+
+:- pred io__stream_info(io__stream::in, maybe(stream_info)::out,
+ io__state::di, io__state::uo) is det.
+
+io__stream_info(Stream, MaybeInfo) -->
+ io__get_stream_db(StreamDb),
+ { map__search(StreamDb, get_stream_id(Stream), Info) ->
+ MaybeInfo = yes(Info)
+ ;
+ MaybeInfo = no
+ }.
+
+io__input_stream_info(StreamDb, Stream) =
+ io__maybe_stream_info(StreamDb, Stream).
+
+io__output_stream_info(StreamDb, Stream) =
+ io__maybe_stream_info(StreamDb, Stream).
+
+io__binary_input_stream_info(StreamDb, Stream) =
+ io__maybe_stream_info(StreamDb, Stream).
+
+io__binary_output_stream_info(StreamDb, Stream) =
+ io__maybe_stream_info(StreamDb, Stream).
+
+:- func io__maybe_stream_info(io__stream_db, io__stream) = maybe_stream_info.
+
+io__maybe_stream_info(StreamDb, Stream) = Info :-
+ ( map__search(StreamDb, get_stream_id(Stream), Info0) ->
+ Info0 = stream(Id, Mode, Content, Source),
+ Info = stream(Id, Mode, Content, Source)
+ ;
+ Info = unknown_stream
+ ).
-:- pred io__get_stream_names(io__stream_names, io__state, io__state).
-:- mode io__get_stream_names(out, di, uo) is det.
+:- func maybe_source_name(maybe(stream_info)) = string.
-:- pred io__set_stream_names(io__stream_names, io__state, io__state).
-:- mode io__set_stream_names(in, di, uo) is det.
+maybe_source_name(MaybeInfo) = Name :-
+ (
+ MaybeInfo = yes(Info),
+ Info = stream(_, _, _, Source),
+ Name = source_name(Source)
+ ;
+ MaybeInfo = no,
+ Name = "<stream name unavailable>"
+ ).
+
+:- func source_name(stream_source) = string.
+
+source_name(file(Name)) = Name.
+source_name(stdin) = "<standard input>".
+source_name(stdout) = "<standard output>".
+source_name(stderr) = "<standard error>".
:- pragma foreign_proc("C",
- io__get_stream_names(StreamNames::out, IO0::di, IO::uo),
+ io__get_stream_db(StreamDb::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- StreamNames = ML_io_stream_names;
+ StreamDb = ML_io_stream_db;
MR_update_io(IO0, IO);
").
+:- pred io__set_stream_db(io__stream_db::in, io__state::di, io__state::uo)
+ is det.
+
:- pragma foreign_proc("C",
- io__set_stream_names(StreamNames::in, IO0::di, IO::uo),
+ io__set_stream_db(StreamDb::in, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- ML_io_stream_names = StreamNames;
+ ML_io_stream_db = StreamDb;
MR_update_io(IO0, IO);
").
:- pragma foreign_proc("MC++",
- io__get_stream_names(StreamNames::out, IO0::di, IO::uo),
+ io__get_stream_db(StreamDb::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- StreamNames = ML_io_stream_names;
+ StreamDb = ML_io_stream_db;
MR_update_io(IO0, IO);
").
:- pragma foreign_proc("MC++",
- io__set_stream_names(StreamNames::in, IO0::di, IO::uo),
+ io__set_stream_db(StreamDb::in, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- ML_io_stream_names = StreamNames;
+ ML_io_stream_db = StreamDb;
MR_update_io(IO0, IO);
").
-:- pred io__delete_stream_name(io__stream, io__state, io__state).
-:- mode io__delete_stream_name(in, di, uo) is det.
+%-----------------------------------------------------------------------------%
-io__delete_stream_name(Stream) -->
- io__get_stream_names(StreamNames0),
- { map__delete(StreamNames0, get_stream_id(Stream), StreamNames) },
- io__set_stream_names(StreamNames).
+:- pred io__insert_stream_info(io__stream::in, stream_info::in,
+ io__state::di, io__state::uo) is det.
-:- pred io__insert_stream_name(io__stream, string, io__state, io__state).
-:- mode io__insert_stream_name(in, in, di, uo) is det.
+io__insert_stream_info(Stream, Name) -->
+ io__get_stream_db(StreamDb0),
+ { map__set(StreamDb0, get_stream_id(Stream), Name, StreamDb) },
+ io__set_stream_db(StreamDb).
-io__insert_stream_name(Stream, Name) -->
- io__get_stream_names(StreamNames0),
- { map__set(StreamNames0, get_stream_id(Stream), Name, StreamNames) },
- io__set_stream_names(StreamNames).
+:- pred io__maybe_delete_stream_info(io__stream::in,
+ io__state::di, io__state::uo) is det.
+
+io__maybe_delete_stream_info(Stream) -->
+ io__may_delete_stream_info(MayDeleteStreamInfo),
+ ( { MayDeleteStreamInfo \= 0 } ->
+ io__get_stream_db(StreamDb0),
+ { map__delete(StreamDb0, get_stream_id(Stream), StreamDb) },
+ io__set_stream_db(StreamDb)
+ ;
+ []
+ ).
+
+% Return an integer that is nonzero if and only if we should delete
+% the information we have about stream when that stream is closed.
+% The debugger may need this information in order to display the stream id
+% in a user-friendly manner even after the stream is closed (e.g. after
+% performing a retry after the close), so if debugging is enabled, we
+% hang on to the stream info until the end of the execution. This is a
+% space leak, but one that is acceptable in a program being debugged.
+
+:- pred io__may_delete_stream_info(int::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ io__may_delete_stream_info(MayDelete::out, IO0::di, IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
+ MayDelete = !MR_trace_ever_enabled;
+ IO = IO0;
+").
+
+io__may_delete_stream_info(1, !IO).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -4163,7 +4293,7 @@
** for accurate GC we embed an ID in the MercuryFile
** and retrieve it here.
*/
- Id = ((MercuryFile *) Stream)->id;
+ Id = (Stream)->id;
#endif
").
@@ -4247,10 +4377,10 @@
:- pragma export(io__init_state(di, uo), "ML_io_init_state").
io__init_state -->
- io__gc_init(type_of(StreamNames), type_of(Globals)),
- { map__init(StreamNames) },
+ io__gc_init(type_of(StreamDb), type_of(Globals)),
+ { map__init(StreamDb) },
{ type_to_univ("<globals>", Globals) },
- io__set_stream_names(StreamNames),
+ io__set_stream_db(StreamDb),
io__set_op_table(ops__init_mercury_op_table),
io__set_globals(Globals),
io__insert_std_stream_names.
@@ -4272,20 +4402,20 @@
:- mode io__gc_init(in, in, di, uo) is det.
:- pragma foreign_proc("C",
- io__gc_init(StreamNamesType::in, UserGlobalsType::in, IO0::di, IO::uo),
+ io__gc_init(StreamDbType::in, UserGlobalsType::in, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
/* for Windows DLLs, we need to call GC_INIT() from each DLL */
#ifdef MR_CONSERVATIVE_GC
GC_INIT();
#endif
- MR_add_root(&ML_io_stream_names, (MR_TypeInfo) StreamNamesType);
+ MR_add_root(&ML_io_stream_db, (MR_TypeInfo) StreamDbType);
MR_add_root(&ML_io_user_globals, (MR_TypeInfo) UserGlobalsType);
MR_update_io(IO0, IO);
").
:- pragma foreign_proc("MC++",
- io__gc_init(_StreamNamesType::in, _UserGlobalsType::in,
+ io__gc_init(_StreamDbType::in, _UserGlobalsType::in,
IO0::di, IO::uo),
[will_not_call_mercury, promise_pure],
"
@@ -4299,11 +4429,11 @@
io__insert_std_stream_names -->
io__stdin_stream(Stdin),
- io__insert_stream_name(Stdin, "<standard input>"),
+ io__insert_stream_info(Stdin, stream(0, input, preopen, stdin)),
io__stdout_stream(Stdout),
- io__insert_stream_name(Stdout, "<standard output>"),
+ io__insert_stream_info(Stdout, stream(1, output, preopen, stdout)),
io__stderr_stream(Stderr),
- io__insert_stream_name(Stderr, "<standard error>").
+ io__insert_stream_info(Stderr, stream(1, output, preopen, stderr)).
io__call_system(Command, Result) -->
io__call_system_return_signal(Command, Result0),
@@ -4418,14 +4548,14 @@
#define MR_update_io(r_src, r_dest) ((r_dest) = (r_src))
void mercury_init_io(void);
-MercuryFile* mercury_open(const char *filename, const char *openmode);
-void mercury_io_error(MercuryFile* mf, const char *format, ...);
-void mercury_output_error(MercuryFile* mf);
-void mercury_print_string(MercuryFile* mf, const char *s);
-void mercury_print_binary_string(MercuryFile* mf, const char *s);
-int mercury_getc(MercuryFile* mf);
-void mercury_close(MercuryFile* mf);
-int ML_fprintf(MercuryFile* mf, const char *format, ...);
+MercuryFilePtr mercury_open(const char *filename, const char *openmode);
+void mercury_io_error(MercuryFilePtr mf, const char *format, ...);
+void mercury_output_error(MercuryFilePtr mf);
+void mercury_print_string(MercuryFilePtr mf, const char *s);
+void mercury_print_binary_string(MercuryFilePtr mf, const char *s);
+int mercury_getc(MercuryFilePtr mf);
+void mercury_close(MercuryFilePtr mf);
+int ML_fprintf(MercuryFilePtr mf, const char *format, ...);
").
@@ -4492,10 +4622,10 @@
MercuryFile mercury_stdin_binary;
MercuryFile mercury_stdout_binary;
-MercuryFile *mercury_current_text_input = &mercury_stdin;
-MercuryFile *mercury_current_text_output = &mercury_stdout;
-MercuryFile *mercury_current_binary_input = &mercury_stdin_binary;
-MercuryFile *mercury_current_binary_output = &mercury_stdout_binary;
+MercuryFilePtr mercury_current_text_input = &mercury_stdin;
+MercuryFilePtr mercury_current_text_output = &mercury_stdout;
+MercuryFilePtr mercury_current_binary_input = &mercury_stdin_binary;
+MercuryFilePtr mercury_current_binary_output = &mercury_stdout_binary;
void
mercury_init_io(void)
@@ -4537,8 +4667,8 @@
static MR_MercuryFile
mercury_file_init(System::IO::Stream *stream,
- System::IO::TextReader *reader, System::IO::TextWriter *writer,
- ML_file_encoding_kind file_encoding)
+ System::IO::TextReader *reader, System::IO::TextWriter *writer,
+ ML_file_encoding_kind file_encoding)
{
MR_MercuryFile mf = new MR_MercuryFileStruct();
mf->stream = stream;
@@ -4588,14 +4718,16 @@
:- pragma foreign_code("C", "
-MercuryFile*
+MercuryFilePtr
mercury_open(const char *filename, const char *openmode)
{
- MercuryFile *mf;
+ MercuryFilePtr mf;
FILE *f;
f = fopen(filename, openmode);
- if (!f) return NULL;
+ if (f == NULL) {
+ return NULL;
+ }
mf = MR_GC_NEW(MercuryFile);
MR_mercuryfile_init(f, 1, mf);
return mf;
@@ -4668,7 +4800,7 @@
:- pragma foreign_code("C", "
void
-mercury_io_error(MercuryFile* mf, const char *format, ...)
+mercury_io_error(MercuryFilePtr mf, const char *format, ...)
{
va_list args;
char message[5000];
@@ -4695,7 +4827,7 @@
:- pragma foreign_code("C", "
void
-mercury_output_error(MercuryFile *mf)
+mercury_output_error(MercuryFilePtr mf)
{
mercury_io_error(mf, ""error writing to output file: %s"",
strerror(errno));
@@ -4706,7 +4838,7 @@
:- pragma foreign_code("C", "
void
-mercury_print_string(MercuryFile* mf, const char *s)
+mercury_print_string(MercuryFilePtr mf, const char *s)
{
if (ML_fprintf(mf, ""%s"", s) < 0) {
mercury_output_error(mf);
@@ -4789,7 +4921,7 @@
:- pragma foreign_code("C", "
void
-mercury_print_binary_string(MercuryFile* mf, const char *s)
+mercury_print_binary_string(MercuryFilePtr mf, const char *s)
{
if (ML_fprintf(mf, ""%s"", s) < 0) {
mercury_output_error(mf);
@@ -4801,7 +4933,7 @@
:- pragma foreign_code("C", "
int
-mercury_getc(MercuryFile* mf)
+mercury_getc(MercuryFilePtr mf)
{
int c = MR_GETCH(*mf);
if (c == '\\n') {
@@ -5062,7 +5194,7 @@
#endif /* MR_NEW_MERCURYFILE_STRUCT */
void
-mercury_close(MercuryFile* mf)
+mercury_close(MercuryFilePtr mf)
{
if (MR_CLOSE(*mf) < 0) {
mercury_io_error(mf, ""error closing file: %s"",
@@ -5164,7 +5296,7 @@
:- pragma foreign_code("C", "
int
-ML_fprintf(MercuryFile* mf, const char *format, ...)
+ML_fprintf(MercuryFilePtr mf, const char *format, ...)
{
int rc;
va_list args;
@@ -5184,7 +5316,7 @@
io__read_char_code(File::in, CharCode::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- CharCode = mercury_getc((MercuryFile *) File);
+ CharCode = mercury_getc(File);
MR_update_io(IO0, IO);
").
@@ -5192,7 +5324,7 @@
io__read_byte_val(File::in, ByteVal::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- ByteVal = mercury_getc((MercuryFile *) File);
+ ByteVal = mercury_getc(File);
MR_update_io(IO0, IO);
").
@@ -5200,7 +5332,7 @@
io__putback_char(File::in, Character::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io],
"{
- MercuryFile* mf = (MercuryFile *) File;
+ MercuryFilePtr mf = File;
if (Character == '\\n') {
MR_line_number(*mf)--;
}
@@ -5215,7 +5347,7 @@
io__putback_byte(File::in, Character::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io],
"{
- MercuryFile* mf = (MercuryFile *) File;
+ MercuryFilePtr mf = File;
/* XXX should work even if ungetc() fails */
if (MR_UNGETCH(*mf, Character) == EOF) {
mercury_io_error(mf, ""io__putback_byte: ungetc failed"");
@@ -5458,14 +5590,14 @@
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
static const int seek_flags[] = { SEEK_SET, SEEK_CUR, SEEK_END };
- MercuryFile *stream = (MercuryFile *) Stream;
+
/* XXX should check for failure */
/* XXX should also check if the stream is seekable */
- if (MR_IS_FILE_STREAM(*stream)) {
- fseek(MR_file(*stream), Off, seek_flags[Flag]);
+ if (MR_IS_FILE_STREAM(*Stream)) {
+ fseek(MR_file(*Stream), Off, seek_flags[Flag]);
} else {
- mercury_io_error(stream,
- ""io__seek_binary_2: unseekable stream"");
+ mercury_io_error(Stream,
+ ""io__seek_binary_2: unseekable stream"");
}
MR_update_io(IO0, IO);
}").
@@ -5474,13 +5606,12 @@
io__binary_stream_offset(Stream::in, Offset::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
/* XXX should check for failure */
/* XXX should check if the stream is tellable */
- if (MR_IS_FILE_STREAM(*stream)) {
- Offset = ftell(MR_file(*stream));
+ if (MR_IS_FILE_STREAM(*Stream)) {
+ Offset = ftell(MR_file(*Stream));
} else {
- mercury_io_error(stream,
+ mercury_io_error(Stream,
""io__binary_stream_offset: untellable stream"");
}
MR_update_io(IO0, IO);
@@ -5492,8 +5623,7 @@
io__write_string(Stream::in, Message::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
- mercury_print_string(stream, Message);
+ mercury_print_string(Stream, Message);
MR_update_io(IO0, IO);
}").
@@ -5501,12 +5631,11 @@
io__write_char(Stream::in, Character::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
- if (MR_PUTCH(*stream, Character) < 0) {
- mercury_output_error(stream);
+ if (MR_PUTCH(*Stream, Character) < 0) {
+ mercury_output_error(Stream);
}
if (Character == '\\n') {
- MR_line_number(*stream)++;
+ MR_line_number(*Stream)++;
}
MR_update_io(IO0, IO);
}").
@@ -5515,9 +5644,8 @@
io__write_int(Stream::in, Val::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
- if (ML_fprintf(stream, ""%ld"", (long) Val) < 0) {
- mercury_output_error(stream);
+ if (ML_fprintf(Stream, ""%ld"", (long) Val) < 0) {
+ mercury_output_error(Stream);
}
MR_update_io(IO0, IO);
}").
@@ -5526,11 +5654,10 @@
io__write_float(Stream::in, Val::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
char buf[MR_SPRINTF_FLOAT_BUF_SIZE];
MR_sprintf_float(buf, Val);
- if (ML_fprintf(stream, ""%s"", buf) < 0) {
- mercury_output_error(stream);
+ if (ML_fprintf(Stream, ""%s"", buf) < 0) {
+ mercury_output_error(Stream);
}
MR_update_io(IO0, IO);
}").
@@ -5539,10 +5666,9 @@
io__write_byte(Stream::in, Byte::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
/* call putc with a strictly non-negative byte-sized integer */
- if (MR_PUTCH(*stream, (int) ((unsigned char) Byte)) < 0) {
- mercury_output_error(stream);
+ if (MR_PUTCH(*Stream, (int) ((unsigned char) Byte)) < 0) {
+ mercury_output_error(Stream);
}
MR_update_io(IO0, IO);
}").
@@ -5551,8 +5677,7 @@
io__write_bytes(Stream::in, Message::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
- mercury_print_binary_string(stream, Message);
+ mercury_print_binary_string(Stream, Message);
MR_update_io(IO0, IO);
}").
@@ -5560,9 +5685,8 @@
io__flush_output(Stream::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
- if (MR_FLUSH(*stream) < 0) {
- mercury_output_error(stream);
+ if (MR_FLUSH(*Stream) < 0) {
+ mercury_output_error(Stream);
}
MR_update_io(IO0, IO);
}").
@@ -5571,9 +5695,8 @@
io__flush_binary_output(Stream::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
- if (MR_FLUSH(*stream) < 0) {
- mercury_output_error(stream);
+ if (MR_FLUSH(*Stream) < 0) {
+ mercury_output_error(Stream);
}
MR_update_io(IO0, IO);
}").
@@ -5680,7 +5803,7 @@
io__stdin_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
- Stream = (MR_Word) &mercury_stdin;
+ Stream = &mercury_stdin;
MR_update_io(IO0, IO);
").
@@ -5688,7 +5811,7 @@
io__stdout_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
- Stream = (MR_Word) &mercury_stdout;
+ Stream = &mercury_stdout;
MR_update_io(IO0, IO);
").
@@ -5696,7 +5819,7 @@
io__stderr_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
- Stream = (MR_Word) &mercury_stderr;
+ Stream = &mercury_stderr;
MR_update_io(IO0, IO);
").
@@ -5704,7 +5827,7 @@
io__stdin_binary_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
- Stream = (MR_Word) &mercury_stdin_binary;
+ Stream = &mercury_stdin_binary;
MR_update_io(IO0, IO);
").
@@ -5712,7 +5835,7 @@
io__stdout_binary_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
- Stream = (MR_Word) &mercury_stdout_binary;
+ Stream = &mercury_stdout_binary;
MR_update_io(IO0, IO);
").
@@ -5720,7 +5843,7 @@
io__input_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- Stream = (MR_Word) mercury_current_text_input;
+ Stream = mercury_current_text_input;
MR_update_io(IO0, IO);
").
@@ -5728,7 +5851,7 @@
io__output_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- Stream = (MR_Word) mercury_current_text_output;
+ Stream = mercury_current_text_output;
MR_update_io(IO0, IO);
").
@@ -5736,7 +5859,7 @@
io__binary_input_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- Stream = (MR_Word) mercury_current_binary_input;
+ Stream = mercury_current_binary_input;
MR_update_io(IO0, IO);
").
@@ -5744,7 +5867,7 @@
io__binary_output_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- Stream = (MR_Word) mercury_current_binary_output;
+ Stream = mercury_current_binary_output;
MR_update_io(IO0, IO);
").
@@ -5760,8 +5883,7 @@
io__get_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
- LineNum = MR_line_number(*stream);
+ LineNum = MR_line_number(*Stream);
MR_update_io(IO0, IO);
}").
@@ -5777,8 +5899,7 @@
io__set_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
- MR_line_number(*stream) = LineNum;
+ MR_line_number(*Stream) = LineNum;
MR_update_io(IO0, IO);
}").
@@ -5794,8 +5915,7 @@
io__get_output_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
- LineNum = MR_line_number(*stream);
+ LineNum = MR_line_number(*Stream);
MR_update_io(IO0, IO);
}").
@@ -5811,8 +5931,7 @@
io__set_output_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"{
- MercuryFile *stream = (MercuryFile *) Stream;
- MR_line_number(*stream) = LineNum;
+ MR_line_number(*Stream) = LineNum;
MR_update_io(IO0, IO);
}").
@@ -5828,8 +5947,8 @@
io__set_input_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- OutStream = (MR_Word) mercury_current_text_input;
- mercury_current_text_input = (MercuryFile *) NewStream;
+ OutStream = mercury_current_text_input;
+ mercury_current_text_input = NewStream;
MR_update_io(IO0, IO);
").
@@ -5837,8 +5956,8 @@
io__set_output_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- OutStream = (MR_Word) mercury_current_text_output;
- mercury_current_text_output = (MercuryFile *) NewStream;
+ OutStream = mercury_current_text_output;
+ mercury_current_text_output = NewStream;
MR_update_io(IO0, IO);
").
@@ -5847,8 +5966,8 @@
IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- OutStream = (MR_Word) mercury_current_binary_input;
- mercury_current_binary_input = (MercuryFile *) NewStream;
+ OutStream = mercury_current_binary_input;
+ mercury_current_binary_input = NewStream;
MR_update_io(IO0, IO);
").
@@ -5857,8 +5976,8 @@
IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io],
"
- OutStream = (MR_Word) mercury_current_binary_output;
- mercury_current_binary_output = (MercuryFile *) NewStream;
+ OutStream = mercury_current_binary_output;
+ mercury_current_binary_output = NewStream;
MR_update_io(IO0, IO);
").
@@ -6053,66 +6172,81 @@
/* stream open/close predicates */
-% io__do_open(File, Mode, ResultCode, Stream, IO0, IO1).
-% Attempts to open a file in the specified mode.
-% ResultCode is 0 for success, -1 for failure.
+% io__do_open_binary(File, Mode, ResultCode, StreamId, Stream, IO0, IO):
+% io__do_open_text(File, Mode, ResultCode, StreamId, Stream, IO0, IO):
+% Attempts to open a file in the specified mode.
+% The Mode is a string suitable for passing to fopen().
+% Result is 0 for success, -1 for failure.
+% StreamId is a unique integer identifying the open.
+% Both StreamId and Stream are valid only if Result == 0.
+
+:- pred io__do_open_binary(string::in, string::in, int::out, int::out,
+ io__input_stream::out, io__state::di, io__state::uo) is det.
+
+:- pred io__do_open_text(string::in, string::in, int::out, int::out,
+ io__input_stream::out, io__state::di, io__state::uo) is det.
+
:- pragma foreign_proc("C",
io__do_open_text(FileName::in, Mode::in, ResultCode::out,
- Stream::out, IO0::di, IO::uo),
+ StreamId::out, Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
- Stream = (MR_Word) mercury_open(FileName, Mode);
- ResultCode = (Stream ? 0 : -1);
+ Stream = mercury_open(FileName, Mode);
+ ResultCode = (Stream != NULL ? 0 : -1);
+ StreamId = (Stream != NULL ? ML_next_stream_id++ : -1);
MR_update_io(IO0, IO);
").
:- pragma foreign_proc("C",
io__do_open_binary(FileName::in, Mode::in, ResultCode::out,
- Stream::out, IO0::di, IO::uo),
+ StreamId::out, Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
- Stream = (MR_Word) mercury_open(FileName, Mode);
- ResultCode = (Stream ? 0 : -1);
+ Stream = mercury_open(FileName, Mode);
+ ResultCode = (Stream != NULL ? 0 : -1);
+ StreamId = (Stream != NULL ? ML_next_stream_id++ : -1);
MR_update_io(IO0, IO);
").
:- pragma foreign_proc("MC++",
io__do_open_text(FileName::in, Mode::in, ResultCode::out,
- Stream::out, IO0::di, IO::uo),
+ StreamId::out, Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
MR_MercuryFile mf = mercury_open(FileName, Mode,
ML_default_text_encoding);
MR_c_pointer_to_word(Stream, mf);
ResultCode = (mf ? 0 : -1);
+ StreamId = (mf ? mf->id : -1);
MR_update_io(IO0, IO);
").
:- pragma foreign_proc("MC++",
io__do_open_binary(FileName::in, Mode::in, ResultCode::out,
- Stream::out, IO0::di, IO::uo),
+ StreamId::out, Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
MR_MercuryFile mf = mercury_open(FileName, Mode, ML_raw_binary);
MR_c_pointer_to_word(Stream, mf);
ResultCode = (mf ? 0 : -1);
+ StreamId = (mf ? mf->id : -1);
MR_update_io(IO0, IO);
").
io__close_input(Stream) -->
- io__delete_stream_name(Stream),
+ io__maybe_delete_stream_info(Stream),
io__close_stream(Stream).
io__close_output(Stream) -->
- io__delete_stream_name(Stream),
+ io__maybe_delete_stream_info(Stream),
io__close_stream(Stream).
io__close_binary_input(Stream) -->
- io__delete_stream_name(Stream),
+ io__maybe_delete_stream_info(Stream),
io__close_stream(Stream).
io__close_binary_output(Stream) -->
- io__delete_stream_name(Stream),
+ io__maybe_delete_stream_info(Stream),
io__close_stream(Stream).
:- pred io__close_stream(stream::in, io__state::di, io__state::uo) is det.
@@ -6121,7 +6255,7 @@
io__close_stream(Stream::in, IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
- mercury_close((MercuryFile *) Stream);
+ mercury_close(Stream);
MR_update_io(IO0, IO);
").
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_init.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_init.h,v
retrieving revision 1.39
diff -u -r1.39 mercury_init.h
--- runtime/mercury_init.h 21 Aug 2002 11:27:42 -0000 1.39
+++ runtime/mercury_init.h 26 Jul 2003 12:59:04 -0000
@@ -86,6 +86,7 @@
etc. */
#include "mercury_trace_base.h" /* for MR_trace_port */
#include "mercury_type_info.h" /* for MR_TypeCtorInfo_Struct */
+#include "mercury_library_types.h" /* for MercuryFilePtr */
#ifdef MR_CONSERVATIVE_GC
#ifdef MR_MPS_GC
@@ -118,11 +119,11 @@
extern void mercury_init_io(void);
extern void ML_io_init_state(void);
extern void ML_io_finalize_state(void);
-extern void ML_io_stderr_stream(MR_Word *);
-extern void ML_io_stdout_stream(MR_Word *);
-extern void ML_io_stdin_stream(MR_Word *);
+extern void ML_io_stderr_stream(MercuryFilePtr *);
+extern void ML_io_stdout_stream(MercuryFilePtr *);
+extern void ML_io_stdin_stream(MercuryFilePtr *);
-extern void ML_io_print_to_stream(MR_Word, MR_Word, MR_Word);
+extern void ML_io_print_to_stream(MR_Word, MercuryFilePtr, MR_Word);
extern void ML_io_print_to_cur_stream(MR_Word, MR_Word);
/* in trace/mercury_trace_internal.h */
Index: runtime/mercury_layout_util.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_layout_util.c,v
retrieving revision 1.30
diff -u -r1.30 mercury_layout_util.c
--- runtime/mercury_layout_util.c 2 Apr 2003 23:01:39 -0000 1.30
+++ runtime/mercury_layout_util.c 26 Jul 2003 13:00:59 -0000
@@ -701,7 +701,7 @@
void
MR_write_variable(MR_TypeInfo type_info, MR_Word value)
{
- MR_Word stdout_stream;
+ MercuryFilePtr stdout_stream;
(*MR_io_stdout_stream)(&stdout_stream);
(*MR_io_print_to_stream)((MR_Word) type_info, stdout_stream, value);
Index: runtime/mercury_library_types.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_library_types.h,v
retrieving revision 1.11
diff -u -r1.11 mercury_library_types.h
--- runtime/mercury_library_types.h 11 Jun 2003 12:55:58 -0000 1.11
+++ runtime/mercury_library_types.h 26 Jul 2003 11:53:09 -0000
@@ -147,4 +147,6 @@
#endif /* MR_NEW_MERCURYFILE_STRUCT */
+typedef MercuryFile *MercuryFilePtr;
+
#endif /* not MERCURY_LIBRARY_TYPES_H */
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.51
diff -u -r1.51 mercury_trace_base.c
--- runtime/mercury_trace_base.c 12 Jun 2003 15:38:26 -0000 1.51
+++ runtime/mercury_trace_base.c 4 Aug 2003 01:36:57 -0000
@@ -41,6 +41,7 @@
void (*MR_trace_shutdown)(void) = NULL;
MR_bool MR_trace_enabled = MR_FALSE;
+MR_bool MR_trace_ever_enabled = MR_FALSE;
MR_Unsigned MR_trace_call_seqno = 0;
MR_Unsigned MR_trace_call_depth = 0;
MR_Unsigned MR_trace_event_number = 0;
Index: runtime/mercury_trace_base.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_base.h,v
retrieving revision 1.34
diff -u -r1.34 mercury_trace_base.h
--- runtime/mercury_trace_base.h 4 Jul 2003 03:27:11 -0000 1.34
+++ runtime/mercury_trace_base.h 26 Jul 2003 10:13:27 -0000
@@ -128,6 +128,15 @@
extern MR_bool MR_trace_enabled;
/*
+** MR_trace_ever_enabled will keep the same value throughout the execution of
+** the entire program after being set in mercury_wrapper.c to the same value
+** as MR_trace_enabled. Unlike MR_trace_enabled, it is never reset, so one can
+** use its value to test whether tracing was ever enabled.
+*/
+
+extern MR_bool MR_trace_ever_enabled;
+
+/*
** MR_trace_call_seqno counts distinct calls. The prologue of every
** procedure assigns the current value of this counter as the sequence number
** of that invocation and increments the counter. This and retry are the only
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.121
diff -u -r1.121 mercury_wrapper.c
--- runtime/mercury_wrapper.c 23 Aug 2003 13:31:04 -0000 1.121
+++ runtime/mercury_wrapper.c 25 Aug 2003 04:45:44 -0000
@@ -299,11 +299,11 @@
void (*MR_library_finalizer)(void);
/* normally ML_io_finalize_state (io__finalize_state/2) */
-void (*MR_io_stderr_stream)(MR_Word *);
-void (*MR_io_stdout_stream)(MR_Word *);
-void (*MR_io_stdin_stream)(MR_Word *);
+void (*MR_io_stderr_stream)(MercuryFilePtr *);
+void (*MR_io_stdout_stream)(MercuryFilePtr *);
+void (*MR_io_stdin_stream)(MercuryFilePtr *);
void (*MR_io_print_to_cur_stream)(MR_Word, MR_Word);
-void (*MR_io_print_to_stream)(MR_Word, MR_Word, MR_Word);
+void (*MR_io_print_to_stream)(MR_Word, MercuryFilePtr, MR_Word);
void (*MR_DI_output_current_ptr)(MR_Integer, MR_Integer, MR_Integer,
MR_Word, MR_String, MR_String, MR_Integer, MR_Integer,
@@ -1153,6 +1153,7 @@
case 'D':
MR_trace_enabled = MR_TRUE;
+ MR_trace_ever_enabled = MR_TRUE;
if (MR_streq(MR_optarg, "i"))
MR_trace_handler = MR_TRACE_INTERNAL;
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.58
diff -u -r1.58 mercury_wrapper.h
--- runtime/mercury_wrapper.h 23 Aug 2003 13:31:04 -0000 1.58
+++ runtime/mercury_wrapper.h 25 Aug 2003 04:45:44 -0000
@@ -19,6 +19,7 @@
#include "mercury_trace_base.h" /* for `MR_trace_port' */
#include "mercury_stacks.h" /* for `MR_{Cut,Generator}StackFrame' */
#include "mercury_type_info.h" /* for `MR_TypeCtorInfo' */
+#include "mercury_library_types.h" /* for `MercuryFilePtr' */
#include <stdio.h> /* for `FILE' */
/*
@@ -83,11 +84,12 @@
extern void (*MR_library_initializer)(void);
extern void (*MR_library_finalizer)(void);
-extern void (*MR_io_stderr_stream)(MR_Word *);
-extern void (*MR_io_stdout_stream)(MR_Word *);
-extern void (*MR_io_stdin_stream)(MR_Word *);
+extern void (*MR_io_stderr_stream)(MercuryFilePtr *);
+extern void (*MR_io_stdout_stream)(MercuryFilePtr *);
+extern void (*MR_io_stdin_stream)(MercuryFilePtr *);
extern void (*MR_io_print_to_cur_stream)(MR_Word, MR_Word);
-extern void (*MR_io_print_to_stream)(MR_Word, MR_Word, MR_Word);
+extern void (*MR_io_print_to_stream)(MR_Word, MercuryFilePtr,
+ MR_Word);
extern void (*MR_address_of_mercury_init_io)(void);
extern void (*MR_address_of_init_modules)(void);
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.59
diff -u -r1.59 Mmakefile
--- tests/debugger/declarative/Mmakefile 25 Jul 2003 03:35:03 -0000 1.59
+++ tests/debugger/declarative/Mmakefile 27 Jul 2003 11:39:09 -0000
@@ -29,11 +29,12 @@
ho5 \
if_then_else \
input_term_dep \
+ io_stream_test \
ite_2 \
lpe_example \
mapinit \
- neg_conj \
negation \
+ neg_conj \
oracle_db \
output_term_dep \
pd \
@@ -203,6 +204,10 @@
$(MDB_STD) ./input_term_dep < input_term_dep.inp \
> input_term_dep.out 2>&1
+io_stream_test.out: io_stream_test io_stream_test.inp
+ $(MDB_STD) ./io_stream_test < io_stream_test.inp \
+ > io_stream_test.out 2>&1
+
ite_2.out: ite_2 ite_2.inp
$(MDB) ./ite_2 < ite_2.inp > ite_2.out 2>&1
@@ -255,11 +260,11 @@
special_term_dep.out: special_term_dep special_term_dep.inp
$(MDB_STD) ./special_term_dep < special_term_dep.inp \
- > special_term_dep.out 2>&1
+ > special_term_dep.out 2>&1
tabled_read_decl.out: tabled_read_decl tabled_read_decl.inp
$(MDB_STD) ./tabled_read_decl < tabled_read_decl.inp \
- > tabled_read_decl.out 2>&1
+ > tabled_read_decl.out 2>&1
# We need to pipe the output through sed to avoid hard-coding dependencies on
# particular line numbers in the standard library source code.
Index: tests/debugger/declarative/io_stream_test.exp
===================================================================
RCS file: tests/debugger/declarative/io_stream_test.exp
diff -N tests/debugger/declarative/io_stream_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/io_stream_test.exp 6 Aug 2003 15:14:50 -0000
@@ -0,0 +1,69 @@
+ E1: C1 1 CALL pred io_stream_test.main/2-0 (det) io_stream_test.m:16
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> context none
+Contexts will not be printed.
+mdb> table_io allow
+mdb> table_io start
+io tabling started
+mdb> break io_stream_test__test
+ 0: + stop interface pred io_stream_test.test/4-0 (det)
+mdb> continue
+ E2: C2 3 CALL pred io_stream_test.test/4-0 (det)
+mdb> print *
+ Stream (arg 1) stream(0, input, text, file("tabled_read_decl.data"))
+ DCG_0 (arg 3) state('<<c_pointer>>')
+mdb> finish -n
+ E3: C2 3 EXIT pred io_stream_test.test/4-0 (det)
+mdb> print *
+ Stream (arg 1) stream(0, input, text, file("tabled_read_decl.data"))
+ N (arg 2) 1123
+ DCG_1 (arg 4) state('<<c_pointer>>')
+mdb> print
+test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, state('<<c_pointer>>'))
+mdb> dd -a
+test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, state('<<c_pointer>>'))
+4 io actions:
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 10)
+Valid? print 1-2
+stream(0, input, text, file("tabled_read_decl.data"))
+1123
+test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, state('<<c_pointer>>'))
+4 io actions:
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 10)
+Valid? p io 1-2
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
+test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, state('<<c_pointer>>'))
+4 io actions:
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 10)
+Valid? no
+test_2(stream(0, input, text, file("tabled_read_decl.data")), 1, 1123, _, state('<<c_pointer>>'))
+4 io actions:
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 10)
+Valid? yes
+Found incorrect contour:
+test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, state('<<c_pointer>>'))
+4 io actions:
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 49)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 50)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 51)
+read_char_code(stream(0, input, text, file("tabled_read_decl.data")), 10)
+Is this a bug? yes
+ E3: C2 3 EXIT pred io_stream_test.test/4-0 (det)
+mdb> c -n -S
+1123
+1456
Index: tests/debugger/declarative/io_stream_test.exp2
===================================================================
RCS file: tests/debugger/declarative/io_stream_test.exp2
diff -N tests/debugger/declarative/io_stream_test.exp2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/io_stream_test.exp2 5 Aug 2003 04:38:37 -0000
@@ -0,0 +1,43 @@
+ E1: C1 1 CALL pred io_stream_test.main/2-0 (det) io_stream_test.m:16
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> context none
+Contexts will not be printed.
+mdb> table_io allow
+mdb> table_io start
+io tabling started
+mdb> break io_stream_test__test
+ 0: + stop interface pred io_stream_test.test/4-0 (det)
+mdb> continue
+ E2: C2 3 CALL pred io_stream_test.test/4-0 (det)
+mdb> print *
+ Stream (arg 1) stream(0, input, text, file("tabled_read_decl.data"))
+ DCG_0 (arg 3) state('<<c_pointer>>')
+mdb> finish -n
+ E3: C2 3 EXIT pred io_stream_test.test/4-0 (det)
+mdb> print *
+ Stream (arg 1) stream(0, input, text, file("tabled_read_decl.data"))
+ N (arg 2) 1123
+ DCG_1 (arg 4) state('<<c_pointer>>')
+mdb> print
+test(stream(0, input, text, file("tabled_read_decl.data")), 1123, _, state('<<c_pointer>>'))
+mdb> dd -a
+test(stream(0, input, text, file("tabled_read_decl.data")), 1456, _, state('<<c_pointer>>'))
+Valid? print 1-2
+stream(0, input, text, file("tabled_read_decl.data"))
+1456
+test(stream(0, input, text, file("tabled_read_decl.data")), 1456, _, state('<<c_pointer>>'))
+Valid? p io 1-2
+No such IO action.
+test(stream(0, input, text, file("tabled_read_decl.data")), 1456, _, state('<<c_pointer>>'))
+Valid? no
+test_2(stream(0, input, text, file("tabled_read_decl.data")), 1, 1456, _, state('<<c_pointer>>'))
+Valid? yes
+Found incorrect contour:
+test(stream(0, input, text, file("tabled_read_decl.data")), 1456, _, state('<<c_pointer>>'))
+Is this a bug? yes
+ E3: C2 3 EXIT pred io_stream_test.test/4-0 (det)
+mdb> c -n -S
+1789
+142
Index: tests/debugger/declarative/io_stream_test.inp
===================================================================
RCS file: tests/debugger/declarative/io_stream_test.inp
diff -N tests/debugger/declarative/io_stream_test.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/io_stream_test.inp 27 Jul 2003 13:02:47 -0000
@@ -0,0 +1,18 @@
+echo on
+register --quiet
+context none
+table_io allow
+table_io start
+break io_stream_test__test
+continue
+print *
+finish -n
+print *
+print
+dd -a
+print 1-2
+p io 1-2
+no
+yes
+yes
+c -n -S
Index: tests/debugger/declarative/io_stream_test.m
===================================================================
RCS file: tests/debugger/declarative/io_stream_test.m
diff -N tests/debugger/declarative/io_stream_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/io_stream_test.m 27 Jul 2003 13:03:34 -0000
@@ -0,0 +1,61 @@
+% Test the declarative debugger's handling of I/O streams.
+
+:- module io_stream_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module list, char, int.
+
+main -->
+ io__open_input("tabled_read_decl.data", Res),
+ ( { Res = ok(Stream) } ->
+ io_stream_test__part_1(Stream),
+ io_stream_test__part_2(Stream)
+ ;
+ io__write_string("could not open tabled_read.data\n")
+ ).
+
+:- pred io_stream_test__part_1(io__input_stream::in,
+ io__state::di, io__state::uo) is det.
+
+io_stream_test__part_1(Stream) -->
+ io_stream_test__test(Stream, A),
+ io__write_int(A),
+ io__nl.
+
+:- pred io_stream_test__part_2(io__input_stream::in,
+ io__state::di, io__state::uo) is det.
+
+io_stream_test__part_2(Stream) -->
+ io_stream_test__test(Stream, A),
+ io__write_int(A),
+ io__nl.
+
+:- pred io_stream_test__test(io__input_stream::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+io_stream_test__test(Stream, N) -->
+ % BUG: the 1 should be 0
+ io_stream_test__test_2(Stream, 1, N).
+
+:- pred io_stream_test__test_2(io__input_stream::in, int::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+io_stream_test__test_2(Stream, SoFar, N) -->
+ io__read_char(Stream, Res),
+ (
+ { Res = ok(Char) },
+ { char__is_digit(Char) },
+ { char__digit_to_int(Char, CharInt) }
+ ->
+ io_stream_test__test_2(Stream, SoFar * 10 + CharInt, N)
+ ;
+ { N = SoFar }
+ ).
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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