From 80e1a473974eb848c6246ea5b4ff4695f96e5a05 Mon Sep 17 00:00:00 2001 From: Zoltan Somogyi Date: Fri, 11 Mar 2022 18:13:28 +1100 Subject: [PATCH] Carve io.stream_db.m out of io.m. library/io.m: library/io.stream_db.m: Move the data types describing the stream database, and the predicates and functions managing and accessing it, to the new submodule io.stream_db.m. Move the declarations and definitions of the global variables holding the dabase accordingly. library/MODULES_UNDOC: library/library.m: List the new module as an undocumented new module. browser/browse.m: browser/browser_info.m: library/stream.string_writer.m: Get stream information from the new module. --- browser/browse.m | 9 +- browser/browser_info.m | 20 +- library/MODULES_UNDOC | 1 + library/io.m | 378 ++----------------------------- library/io.stream_db.m | 400 +++++++++++++++++++++++++++++++++ library/library.m | 2 + library/stream.string_writer.m | 3 +- 7 files changed, 439 insertions(+), 374 deletions(-) create mode 100644 library/io.stream_db.m diff --git a/browser/browse.m b/browser/browse.m index 73c5f644c..234892cfd 100644 --- a/browser/browse.m +++ b/browser/browse.m @@ -191,6 +191,7 @@ :- import_module io.call_system. :- import_module io.environment. :- import_module io.file. +:- import_module io.stream_db. :- import_module map. :- import_module pair. :- import_module pretty_printer. @@ -700,7 +701,7 @@ portray_flat(Debugger, BrowserTerm, Params, !IO) :- io.output_stream(Stream, !IO), portray_flat_write_browser_term(Stream, BrowserTerm, !IO) else - io.get_stream_db(StreamDb, !IO), + io.stream_db.get_stream_db(StreamDb, !IO), BrowserDb = browser_db(StreamDb), browser_term_to_string(BrowserDb, BrowserTerm, Params ^ size, Params ^ depth, Str), @@ -748,7 +749,7 @@ put_comma_space(Stream, !State) :- io::di, io::uo) is cc_multi. portray_verbose(Debugger, BrowserTerm, Params, !IO) :- - io.get_stream_db(StreamDb, !IO), + io.stream_db.get_stream_db(StreamDb, !IO), BrowserDb = browser_db(StreamDb), browser_term_to_string_verbose(BrowserDb, BrowserTerm, Params ^ size, Params ^ depth, Params ^ width, Params ^ lines, Str), @@ -765,7 +766,7 @@ portray_pretty(Debugger, BrowserTerm, Params, !IO) :- io::di, io::uo) is cc_multi. portray_raw_pretty(Debugger, BrowserTerm, Params, !IO) :- - io.get_stream_db(StreamDb, !IO), + io.stream_db.get_stream_db(StreamDb, !IO), BrowserDb = browser_db(StreamDb), sized_pretty.browser_term_to_string_line(BrowserDb, BrowserTerm, Params ^ width, Params ^ lines, Str), @@ -1508,7 +1509,7 @@ browser_term_to_html_flat_string(BrowserTerm, Str, Elided, !IO) :- Str = to_string(State), Elided = no else - io.get_stream_db(StreamDb, !IO), + io.stream_db.get_stream_db(StreamDb, !IO), BrowserDb = browser_db(StreamDb), MaxSize = 10, MaxDepth = 5, diff --git a/browser/browser_info.m b/browser/browser_info.m index 12fcd7de3..191c670c1 100644 --- a/browser/browser_info.m +++ b/browser/browser_info.m @@ -26,6 +26,7 @@ :- import_module bool. :- import_module getopt. :- import_module io. +:- import_module io.stream_db. :- import_module list. :- import_module maybe. :- import_module stream. @@ -311,7 +312,7 @@ :- type browser_db ---> browser_db( - browser_stream_db :: io.stream_db + browser_stream_db :: io.stream_db.stream_db ). :- pred deconstruct_browser_term_cc(browser_db::in, browser_term::in, @@ -1160,21 +1161,22 @@ functor_browser_term_cc(BrowserDb, BrowserTerm, Functor, Arity, IsFunc) :- :- some [T] func pretty_value(browser_db, univ) = T. pretty_value(BrowserDb, Univ0) = Value :- + StreamDb = BrowserDb ^ browser_stream_db, ( if univ_to_type(Univ0, InputStream) then - io.input_stream_info(BrowserDb ^ browser_stream_db, - InputStream) = InputStreamInfo, + io.stream_db.input_stream_info(StreamDb, InputStream) + = InputStreamInfo, type_to_univ(InputStreamInfo, Univ) else if univ_to_type(Univ0, OutputStream) then - io.output_stream_info(BrowserDb ^ browser_stream_db, - OutputStream) = OutputStreamInfo, + io.stream_db.output_stream_info(StreamDb, OutputStream) + = OutputStreamInfo, type_to_univ(OutputStreamInfo, Univ) else if univ_to_type(Univ0, BinaryInputStream) then - io.binary_input_stream_info(BrowserDb ^ browser_stream_db, - BinaryInputStream) = BinaryInputStreamInfo, + io.stream_db.binary_input_stream_info(StreamDb, BinaryInputStream) + = BinaryInputStreamInfo, type_to_univ(BinaryInputStreamInfo, Univ) else if univ_to_type(Univ0, BinaryOutputStream) then - io.binary_output_stream_info(BrowserDb ^ browser_stream_db, - BinaryOutputStream) = BinaryOutputStreamInfo, + io.stream_db.binary_output_stream_info(StreamDb, BinaryOutputStream) + = BinaryOutputStreamInfo, type_to_univ(BinaryOutputStreamInfo, Univ) else Univ = Univ0 diff --git a/library/MODULES_UNDOC b/library/MODULES_UNDOC index fa7cca798..fe20c800a 100644 --- a/library/MODULES_UNDOC +++ b/library/MODULES_UNDOC @@ -1,4 +1,5 @@ backjump.m +io.stream_db.m mer_std.m mutvar.m par_builtin.m diff --git a/library/io.m b/library/io.m index 59da37102..d47279af4 100644 --- a/library/io.m +++ b/library/io.m @@ -2208,76 +2208,7 @@ % For use by browser/browse.m. % -% Types and predicates for managing the stream info database. - -:- type stream_db == map(stream_id, stream_info). - -:- 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. - -:- type stream_mode - ---> input - ; output - ; append. - -:- type stream_content - ---> text - ; binary - ; preopen. - -:- type stream_source - ---> file(string) % the file name - ; stdin - ; stdout - ; stderr. - - % Retrieves the database mapping streams to the information we have - % about those streams. - % -:- pred get_stream_db(stream_db::out, io::di, io::uo) is det. -:- impure pred get_stream_db_with_locking(stream_db::out) is det. - - % Returns the information associated with the specified input - % stream in the given stream database. - % -:- func input_stream_info(stream_db, io.text_input_stream) - = maybe_stream_info. - - % Returns the information associated with the specified binary input - % stream in the given stream database. - % -:- func binary_input_stream_info(stream_db, io.binary_input_stream) - = maybe_stream_info. - - % Returns the information associated with the specified output - % stream in the given stream database. - % -:- func output_stream_info(stream_db, io.text_output_stream) - = maybe_stream_info. - - % Returns the information associated with the specified binary output - % stream in the given stream database. - % -:- func binary_output_stream_info(stream_db, io.binary_output_stream) - = maybe_stream_info. - - % If the univ contains an I/O stream, return information about that - % stream, otherwise fail. -:- func get_io_stream_info(stream_db, T) = maybe_stream_info is semidet. +:- include_module stream_db. %---------------------% % @@ -2304,6 +2235,7 @@ :- import_module io.call_system. :- import_module io.environment. :- import_module io.file. +:- import_module io.stream_db. :- import_module mercury_term_parser. :- import_module require. :- import_module stream.string_writer. @@ -2487,7 +2419,6 @@ int ML_fprintf(MercuryFilePtr mf, const char *format, ...); "). :- pragma foreign_decl("C", " -extern MR_Word ML_io_stream_db; extern MR_Word ML_io_user_globals; extern int ML_next_stream_id; @@ -2496,14 +2427,12 @@ extern int ML_next_stream_id; #endif #ifdef MR_THREAD_SAFE - extern MercuryLock ML_io_stream_db_lock; extern MercuryLock ML_io_user_globals_lock; extern MercuryLock ML_io_next_stream_id_lock; #endif "). :- pragma foreign_code("C", " -MR_Word ML_io_stream_db; MR_Word ML_io_user_globals; // A counter used to generate unique stream ids. @@ -2513,7 +2442,6 @@ int ML_next_stream_id; #endif #ifdef MR_THREAD_SAFE - MercuryLock ML_io_stream_db_lock; MercuryLock ML_io_user_globals_lock; MercuryLock ML_io_next_stream_id_lock; #endif @@ -2927,8 +2855,6 @@ ML_wide_to_utf8(const wchar_t *ws, MR_AllocSiteInfoPtr alloc_id) %---------------------% :- pragma foreign_code("Java", " - public static tree234.Tree234_2 ML_io_stream_db - = new tree234.Tree234_2.Empty_0(); public static univ.Univ_0 ML_io_user_globals = null; "). @@ -3458,8 +3384,6 @@ using System.Security.Principal; // since the C# code all gets generated inside a class, // but we keep them for consistency with the C code. - public static tree234.Tree234_2 ML_io_stream_db = - new tree234.Tree234_2.Empty_0(); public static univ.Univ_0 ML_io_user_globals; // a counter used to generate unique stream ids @@ -3484,12 +3408,15 @@ using System.Security.Principal; :- pragma foreign_code("C#", " public enum ML_line_ending_kind { - ML_OS_line_ending, // file uses the usual line-ending convention - // for the OS (e.g. CR-LF for DOS/Windows). + // file uses the usual line-ending convention + // for the OS (e.g. CR-LF for DOS/Windows). + ML_OS_line_ending, - ML_Unix_line_ending, // file uses the Unix line-encoding convention. + // file uses the Unix line-encoding convention. + ML_Unix_line_ending, - ML_raw_binary // file stores bytes + // file stores bytes + ML_raw_binary }; public class MR_MercuryFileStruct { @@ -3499,15 +3426,16 @@ using System.Security.Principal; // field must check for null and initialize it if needed. // Likewise for the `writer' field. - public System.IO.Stream stream; // The stream itself - public System.IO.TextReader reader; // The stream reader for it - public System.IO.TextWriter writer; // The stream writer for it - public int putback; - // the next character or byte to read, - // or -1 if no putback char/byte is stored + public System.IO.Stream stream; // The stream itself. + public System.IO.TextReader reader; // The stream reader for it. + public System.IO.TextWriter writer; // The stream writer for it. + // The next character or byte to read, + // or -1 if no putback char/byte is stored. + public int putback; + + // DOS, Unix, or raw binary. public ML_line_ending_kind line_ending; - // DOS, Unix, or raw binary public int line_number; public int id; @@ -4784,52 +4712,6 @@ binary_output_stream_name(binary_output_stream(Stream), Name, !IO) :- %---------------------------------------------------------------------------% -:- pred insert_stream_info(stream::in, stream_info::in, - io::di, io::uo) is det. - -insert_stream_info(Stream, Name, !IO) :- - lock_stream_db(!IO), - get_stream_db(StreamDb0, !IO), - map.set(get_stream_id(Stream), Name, StreamDb0, StreamDb), - set_stream_db(StreamDb, !IO), - unlock_stream_db(!IO). - -:- pred maybe_delete_stream_info(io.stream::in, io::di, io::uo) is det. - -maybe_delete_stream_info(Stream, !IO) :- - may_delete_stream_info(MayDeleteStreamInfo, !IO), - ( if MayDeleteStreamInfo = 0 then - true - else - lock_stream_db(!IO), - get_stream_db(StreamDb0, !IO), - map.delete(get_stream_id(Stream), StreamDb0, StreamDb), - set_stream_db(StreamDb, !IO), - unlock_stream_db(!IO) - ). - - % 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 may_delete_stream_info(int::out, io::di, io::uo) is det. - -:- pragma foreign_proc("C", - may_delete_stream_info(MayDelete::out, _IO0::di, _IO::uo), - [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe, - does_not_affect_liveness, no_sharing], -" - MayDelete = !MR_debug_ever_enabled; -"). - -may_delete_stream_info(1, !IO). - -%---------------------% - :- pragma foreign_proc("C", get_line_number(LineNum::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io, @@ -10030,7 +9912,7 @@ init_state(!IO) :- io.gc_init(type_of(StreamDb), type_of(Globals), !IO), map.init(StreamDb), type_to_univ("", Globals), - io.set_stream_db(StreamDb, !IO), + io.stream_db.set_stream_db(StreamDb, !IO), io.set_op_table(ops.init_mercury_op_table, !IO), io.set_globals(Globals, !IO), io.insert_std_stream_names(!IO). @@ -10512,230 +10394,6 @@ get_op_table(ops.init_mercury_op_table, !IO). set_op_table(_OpTable, !IO). -%---------------------% -% -% For use by browser/browse.m. -% - - % Caller must hold the stream_db lock. - -:- pragma foreign_proc("C", - get_stream_db(StreamDb::out, _IO0::di, _IO::uo), - [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, - does_not_affect_liveness], -" - StreamDb = ML_io_stream_db; -"). - -:- pragma foreign_proc("C#", - get_stream_db(StreamDb::out, _IO0::di, _IO::uo), - [will_not_call_mercury, promise_pure, tabled_for_io], -" - StreamDb = io.ML_io_stream_db; -"). - -:- pragma foreign_proc("Java", - get_stream_db(StreamDb::out, _IO0::di, _IO::uo), - [will_not_call_mercury, promise_pure, tabled_for_io], -" - StreamDb = io.ML_io_stream_db; -"). - -%---------------------% - - % Caller must NOT hold the stream_db lock. - -:- pragma foreign_proc("C", - get_stream_db_with_locking(StreamDb::out), - [will_not_call_mercury, thread_safe, tabled_for_io], -" - MR_LOCK(&ML_io_stream_db_lock, ""io.get_stream_db/1""); - StreamDb = ML_io_stream_db; - MR_UNLOCK(&ML_io_stream_db_lock, ""io.get_stream_db/1""); -"). - -:- pragma foreign_proc("C#", - get_stream_db_with_locking(StreamDb::out), - [will_not_call_mercury, tabled_for_io], -" - StreamDb = io.ML_io_stream_db; -"). - -:- pragma foreign_proc("Java", - get_stream_db_with_locking(StreamDb::out), - [will_not_call_mercury, tabled_for_io], -" - StreamDb = io.ML_io_stream_db; -"). - -%---------------------% - - % Caller must hold the stream_db lock. - % -:- pred set_stream_db(io.stream_db::in, io::di, io::uo) is det. - -:- pragma foreign_proc("C", - set_stream_db(StreamDb::in, _IO0::di, _IO::uo), - [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, - does_not_affect_liveness, no_sharing], -" - ML_io_stream_db = StreamDb; -"). - -:- pragma foreign_proc("C#", - set_stream_db(StreamDb::in, _IO0::di, _IO::uo), - [will_not_call_mercury, promise_pure, tabled_for_io], -" - io.ML_io_stream_db = StreamDb; -"). - -:- pragma foreign_proc("Java", - set_stream_db(StreamDb::in, _IO0::di, _IO::uo), - [will_not_call_mercury, promise_pure, tabled_for_io], -" - io.ML_io_stream_db = StreamDb; -"). - -%---------------------% - -:- pred lock_stream_db(io::di, io::uo) is det. - -:- pragma foreign_proc("C", - io.lock_stream_db(_IO0::di, _IO::uo), - [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, - no_sharing], -" - MR_LOCK(&ML_io_stream_db_lock, ""io.lock_stream_db/2""); -"). - -lock_stream_db(!IO). - -:- pred unlock_stream_db(io::di, io::uo) is det. - -:- pragma foreign_proc("C", - unlock_stream_db(_IO0::di, _IO::uo), - [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, - no_sharing], -" - MR_UNLOCK(&ML_io_stream_db_lock, ""io.unlock_stream_db/2""); -"). - -unlock_stream_db(!IO). - -%---------------------% - -:- pred stream_name(stream::in, string::out, io::di, io::uo) is det. - -stream_name(Stream, Name, !IO) :- - stream_info(Stream, MaybeInfo, !IO), - ( - MaybeInfo = yes(Info), - Info = stream(_, _, _, Source), - Name = source_name(Source) - ; - MaybeInfo = no, - Name = "" - ). - -:- pred stream_info(io.stream::in, maybe(stream_info)::out, - io::di, io::uo) is det. - -stream_info(Stream, MaybeInfo, !IO) :- - lock_stream_db(!IO), - get_stream_db(StreamDb, !IO), - unlock_stream_db(!IO), - ( if map.search(StreamDb, get_stream_id(Stream), Info) then - MaybeInfo = yes(Info) - else - MaybeInfo = no - ). - -%---------------------% - -input_stream_info(StreamDb, input_stream(Stream)) = - maybe_stream_info(StreamDb, Stream). - -binary_input_stream_info(StreamDb, binary_input_stream(Stream)) = - maybe_stream_info(StreamDb, Stream). - -%---------------------% - -output_stream_info(StreamDb, output_stream(Stream)) = - maybe_stream_info(StreamDb, Stream). - -binary_output_stream_info(StreamDb, binary_output_stream(Stream)) = - maybe_stream_info(StreamDb, Stream). - -%---------------------% - -:- func maybe_stream_info(io.stream_db, io.stream) = maybe_stream_info. - -maybe_stream_info(StreamDb, Stream) = Info :- - ( if map.search(StreamDb, get_stream_id(Stream), Info0) then - % Info0 and Info have different types. - Info0 = stream(Id, Mode, Content, Source), - Info = stream(Id, Mode, Content, Source) - else - Info = unknown_stream - ). - -get_io_stream_info(StreamDB, Stream) = StreamInfo :- - ( if dynamic_cast(Stream, input_stream(IOStream0)) then - IOStream = IOStream0 - else if dynamic_cast(Stream, output_stream(IOStream0)) then - IOStream = IOStream0 - else if dynamic_cast(Stream, binary_input_stream(IOStream0)) then - IOStream = IOStream0 - else if dynamic_cast(Stream, binary_output_stream(IOStream0)) then - IOStream = IOStream0 - else if dynamic_cast(Stream, IOStream0) then - IOStream = IOStream0 - else - fail - ), - StreamInfo = io.maybe_stream_info(StreamDB, IOStream). - -:- func source_name(stream_source) = string. - -source_name(file(Name)) = Name. -source_name(stdin) = "". -source_name(stdout) = "". -source_name(stderr) = "". - -%---------------------% - -:- func get_stream_id(stream) = stream_id. - -:- pragma foreign_proc("C", - get_stream_id(Stream::in) = (Id::out), - [will_not_call_mercury, promise_pure, thread_safe, - does_not_affect_liveness, no_sharing], -" -#ifndef MR_NATIVE_GC - // Most of the time, we can just use the pointer to the stream - // as a unique identifier. - Id = (MR_Word) Stream; -#else - // For accurate GC we embed an ID in the MercuryFile - // and retrieve it here. - Id = (Stream)->id; -#endif -"). - -:- pragma foreign_proc("C#", - get_stream_id(Stream::in) = (Id::out), - [will_not_call_mercury, promise_pure], -" - Id = Stream.id; -"). - -:- pragma foreign_proc("Java", - get_stream_id(Stream::in) = (Id::out), - [will_not_call_mercury, promise_pure, may_not_duplicate], -" - Id = Stream.id; -"). - %---------------------------------------------------------------------------% % % Predicates to temporarily change the input/output stream. diff --git a/library/io.stream_db.m b/library/io.stream_db.m new file mode 100644 index 000000000..521150a74 --- /dev/null +++ b/library/io.stream_db.m @@ -0,0 +1,400 @@ +%---------------------------------------------------------------------------% +% vim: ft=mercury ts=4 sw=4 et +%---------------------------------------------------------------------------% +% Copyright (C) 1993-2012 The University of Melbourne. +% Copyright (C) 2013-2022 The Mercury team. +% This file is distributed under the terms specified in COPYING.LIB. +%---------------------------------------------------------------------------% +% +% File: io.stream_db.m. +% +% This module maintains the database of I/O streams. +% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- module io.stream_db. +:- interface. + +:- import_module map. +:- import_module maybe. + +%---------------------------------------------------------------------------% + +% Types and predicates for managing the stream info database. + +:- type stream_db == map(stream_id, stream_info). + +:- 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. + +:- type stream_mode + ---> input + ; output + ; append. + +:- type stream_content + ---> text + ; binary + ; preopen. + +:- type stream_source + ---> file(string) % the file name + ; stdin + ; stdout + ; stderr. + +%---------------------% + + % Retrieves the database mapping streams to the information we have + % about those streams. + % + % For get_stream_db, caller must hold the stream_db lock. + % For get_stream_db_with_locking, caller must NOT hold the stream_db lock. + % +:- pred get_stream_db(stream_db::out, io::di, io::uo) is det. +:- impure pred get_stream_db_with_locking(stream_db::out) is det. + + % Caller must hold the stream_db lock. + % +:- pred set_stream_db(stream_db::in, io::di, io::uo) is det. + +%---------------------% + +:- pred insert_stream_info(stream::in, stream_info::in, + io::di, io::uo) is det. + +:- pred maybe_delete_stream_info(io.stream::in, io::di, io::uo) is det. + +%---------------------% + +:- pred stream_name(stream::in, string::out, io::di, io::uo) is det. + +:- pred stream_info(io.stream::in, maybe(stream_info)::out, + io::di, io::uo) is det. + +%---------------------% + + % Returns the information associated with the specified input + % stream in the given stream database. + % +:- func input_stream_info(stream_db, io.text_input_stream) + = maybe_stream_info. + + % Returns the information associated with the specified binary input + % stream in the given stream database. + % +:- func binary_input_stream_info(stream_db, io.binary_input_stream) + = maybe_stream_info. + + % Returns the information associated with the specified output + % stream in the given stream database. + % +:- func output_stream_info(stream_db, io.text_output_stream) + = maybe_stream_info. + + % Returns the information associated with the specified binary output + % stream in the given stream database. + % +:- func binary_output_stream_info(stream_db, io.binary_output_stream) + = maybe_stream_info. + +%---------------------% + + % If the univ contains an I/O stream, return information about that + % stream, otherwise fail. + % +:- func get_io_stream_info(stream_db, T) = maybe_stream_info is semidet. + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- implementation. + +%---------------------------------------------------------------------------% + +:- pragma foreign_proc("C", + get_stream_db(StreamDb::out, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, + does_not_affect_liveness], +" + StreamDb = ML_io_stream_db; +"). +:- pragma foreign_proc("C#", + get_stream_db(StreamDb::out, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, tabled_for_io], +" + StreamDb = mercury.io__stream_db.ML_io_stream_db; +"). +:- pragma foreign_proc("Java", + get_stream_db(StreamDb::out, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, tabled_for_io], +" + StreamDb = jmercury.io__stream_db.ML_io_stream_db; +"). + +%---------------------% + +:- pragma foreign_proc("C", + get_stream_db_with_locking(StreamDb::out), + [will_not_call_mercury, thread_safe, tabled_for_io], +" + MR_LOCK(&ML_io_stream_db_lock, ""io.get_stream_db/1""); + StreamDb = ML_io_stream_db; + MR_UNLOCK(&ML_io_stream_db_lock, ""io.get_stream_db/1""); +"). +:- pragma foreign_proc("C#", + get_stream_db_with_locking(StreamDb::out), + [will_not_call_mercury, tabled_for_io], +" + StreamDb = mercury.io__stream_db.ML_io_stream_db; +"). +:- pragma foreign_proc("Java", + get_stream_db_with_locking(StreamDb::out), + [will_not_call_mercury, tabled_for_io], +" + StreamDb = jmercury.io__stream_db.ML_io_stream_db; +"). + +%---------------------% + +:- pragma foreign_proc("C", + set_stream_db(StreamDb::in, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, + does_not_affect_liveness, no_sharing], +" + ML_io_stream_db = StreamDb; +"). +:- pragma foreign_proc("C#", + set_stream_db(StreamDb::in, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, tabled_for_io], +" + mercury.io__stream_db.ML_io_stream_db = StreamDb; +"). +:- pragma foreign_proc("Java", + set_stream_db(StreamDb::in, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, tabled_for_io], +" + jmercury.io__stream_db.ML_io_stream_db = StreamDb; +"). + +%---------------------% + +:- pred lock_stream_db(io::di, io::uo) is det. + +:- pragma foreign_proc("C", + lock_stream_db(_IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, + no_sharing], +" + MR_LOCK(&ML_io_stream_db_lock, ""io.lock_stream_db/2""); +"). + +lock_stream_db(!IO). + +:- pred unlock_stream_db(io::di, io::uo) is det. + +:- pragma foreign_proc("C", + unlock_stream_db(_IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io, + no_sharing], +" + MR_UNLOCK(&ML_io_stream_db_lock, ""io.stream_db.unlock_stream_db/2""); +"). + +unlock_stream_db(!IO). + +%---------------------------------------------------------------------------% + +insert_stream_info(Stream, Name, !IO) :- + lock_stream_db(!IO), + get_stream_db(StreamDb0, !IO), + map.set(get_stream_id(Stream), Name, StreamDb0, StreamDb), + set_stream_db(StreamDb, !IO), + unlock_stream_db(!IO). + +maybe_delete_stream_info(Stream, !IO) :- + may_delete_stream_info(MayDeleteStreamInfo, !IO), + ( if MayDeleteStreamInfo = 0 then + true + else + lock_stream_db(!IO), + get_stream_db(StreamDb0, !IO), + map.delete(get_stream_id(Stream), StreamDb0, StreamDb), + set_stream_db(StreamDb, !IO), + unlock_stream_db(!IO) + ). + + % 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 may_delete_stream_info(int::out, io::di, io::uo) is det. + +:- pragma foreign_proc("C", + may_delete_stream_info(MayDelete::out, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe, + does_not_affect_liveness, no_sharing], +" + MayDelete = !MR_debug_ever_enabled; +"). + +may_delete_stream_info(1, !IO). + +%---------------------------------------------------------------------------% + +stream_name(Stream, Name, !IO) :- + stream_info(Stream, MaybeInfo, !IO), + ( + MaybeInfo = yes(Info), + Info = stream(_, _, _, Source), + Name = source_name(Source) + ; + MaybeInfo = no, + Name = "" + ). + +stream_info(Stream, MaybeInfo, !IO) :- + lock_stream_db(!IO), + get_stream_db(StreamDb, !IO), + unlock_stream_db(!IO), + ( if map.search(StreamDb, get_stream_id(Stream), Info) then + MaybeInfo = yes(Info) + else + MaybeInfo = no + ). + +%---------------------------------------------------------------------------% + +input_stream_info(StreamDb, input_stream(Stream)) = + get_maybe_stream_info(StreamDb, Stream). + +binary_input_stream_info(StreamDb, binary_input_stream(Stream)) = + get_maybe_stream_info(StreamDb, Stream). + +output_stream_info(StreamDb, output_stream(Stream)) = + get_maybe_stream_info(StreamDb, Stream). + +binary_output_stream_info(StreamDb, binary_output_stream(Stream)) = + get_maybe_stream_info(StreamDb, Stream). + +:- func get_maybe_stream_info(stream_db, io.stream) = maybe_stream_info. + +get_maybe_stream_info(StreamDb, Stream) = Info :- + ( if map.search(StreamDb, get_stream_id(Stream), Info0) then + % Info0 and Info have different types. + Info0 = stream(Id, Mode, Content, Source), + Info = stream(Id, Mode, Content, Source) + else + Info = unknown_stream + ). + +%---------------------% + +get_io_stream_info(StreamDB, Stream) = StreamInfo :- + ( if dynamic_cast(Stream, input_stream(IOStream0)) then + IOStream = IOStream0 + else if dynamic_cast(Stream, output_stream(IOStream0)) then + IOStream = IOStream0 + else if dynamic_cast(Stream, binary_input_stream(IOStream0)) then + IOStream = IOStream0 + else if dynamic_cast(Stream, binary_output_stream(IOStream0)) then + IOStream = IOStream0 + else if dynamic_cast(Stream, IOStream0) then + IOStream = IOStream0 + else + fail + ), + StreamInfo = get_maybe_stream_info(StreamDB, IOStream). + +:- func source_name(stream_source) = string. + +source_name(file(Name)) = Name. +source_name(stdin) = "". +source_name(stdout) = "". +source_name(stderr) = "". + +%---------------------% + +:- func get_stream_id(stream) = stream_id. + +:- pragma foreign_proc("C", + get_stream_id(Stream::in) = (Id::out), + [will_not_call_mercury, promise_pure, thread_safe, + does_not_affect_liveness, no_sharing], +" +#ifndef MR_NATIVE_GC + // Most of the time, we can just use the pointer to the stream + // as a unique identifier. + Id = (MR_Word) Stream; +#else + // For accurate GC we embed an ID in the MercuryFile and retrieve it here. + Id = (Stream)->id; +#endif +"). +:- pragma foreign_proc("C#", + get_stream_id(Stream::in) = (Id::out), + [will_not_call_mercury, promise_pure], +" + Id = Stream.id; +"). +:- pragma foreign_proc("Java", + get_stream_id(Stream::in) = (Id::out), + [will_not_call_mercury, promise_pure, may_not_duplicate], +" + Id = Stream.id; +"). + +%---------------------------------------------------------------------------% + +:- pragma foreign_decl("C", " +extern MR_Word ML_io_stream_db; + +#ifdef MR_THREAD_SAFE + extern MercuryLock ML_io_stream_db_lock; +#endif +"). + +:- pragma foreign_code("C", " +MR_Word ML_io_stream_db; + +#ifdef MR_THREAD_SAFE + MercuryLock ML_io_stream_db_lock; +#endif +"). + +:- pragma foreign_code("Java", " + public static tree234.Tree234_2 ML_io_stream_db + = new tree234.Tree234_2.Empty_0(); +"). + +:- pragma foreign_code("C#", " + // The ML_ prefixes here are not really needed, + // since the C# code all gets generated inside a class, + // but we keep them for consistency with the C code. + + public static tree234.Tree234_2 ML_io_stream_db = + new tree234.Tree234_2.Empty_0(); +"). + +%---------------------------------------------------------------------------% +:- end_module io.stream_db. +%---------------------------------------------------------------------------% diff --git a/library/library.m b/library/library.m index c3333c280..eef0cf9aa 100644 --- a/library/library.m +++ b/library/library.m @@ -123,6 +123,7 @@ :- import_module io.call_system. :- import_module io.environment. :- import_module io.file. +:- import_module io.stream_db. :- import_module kv_list. :- import_module lazy. :- import_module list. @@ -296,6 +297,7 @@ stdlib_module_doc_undoc("io", doc). stdlib_module_doc_undoc("io.call_system", doc). stdlib_module_doc_undoc("io.environment", doc). stdlib_module_doc_undoc("io.file", doc). +stdlib_module_doc_undoc("io.stream_db", undoc). stdlib_module_doc_undoc("kv_list", doc). stdlib_module_doc_undoc("lazy", doc). stdlib_module_doc_undoc("library", doc). diff --git a/library/stream.string_writer.m b/library/stream.string_writer.m index 4b32d1576..8b6e97300 100644 --- a/library/stream.string_writer.m +++ b/library/stream.string_writer.m @@ -236,6 +236,7 @@ :- import_module calendar. :- import_module int. :- import_module integer. +:- import_module io.stream_db. :- import_module require. :- import_module rtti_implementation. :- import_module term_io. @@ -926,7 +927,7 @@ do_write_univ_prio(Stream, NonCanon, Univ, Priority, !State) :- ; TypeCtorModuleName = "io", ( if - impure io.get_stream_db_with_locking(StreamDB), + impure get_stream_db_with_locking(StreamDB), StreamInfo = get_io_stream_info(StreamDB, univ_value(Univ)) then type_to_univ(StreamInfo, StreamInfoUniv),