[m-rev.] for review: io.write for streams
Simon Taylor
staylr at gmail.com
Fri Dec 15 18:30:58 AEDT 2006
Estimated hours taken: 25
Branches: main
Implement io.write for arbitrary streams. With type specialization
this is only slightly slower than the original.
library/stream.string_writer.m:
A module containing predicates for writing to streams
which accept strings.
library/stream.m:
Move stream.format to stream.string_writer.m.
Add stream.put_list, which is like io.write_list.
library/io.m:
Move io.write and io.print to stream.string_writer.m.
library/term_io.m:
Add stream versions of predicates used by io.write.
library/ops.m:
Move io.adjust_priority_for_assoc to here (private
predicate used only by library modules).
Export ops.mercury_max_priority for use by
stream.string_writer.write.
Mmake.common.in:
compiler/modules.m:
compiler/mlds.m:
compiler/mlds_to_c.m:
compiler/mlds_to_java.m:
compiler/mlds_to_managed.m:
compiler/prog_util.m:
Allow sub-modules in the standard library.
compiler/polymorphism.m:
Fix a bug which caused tests/hard_coded/print_stream.m to
fail with this change. The wrong argument type_info would
be extracted from a typeclass_info if the constraints of the
typeclass-info were not all variables.
browser/browse.m:
tests/hard_coded/stream_format.m:
tests/hard_coded/test_injection.m:
tests/invalid/string_format_bad.m:
tests/invalid/string_format_unknown.m:
Updated for predicates moving between library modules.
util/mdemangle.c:
The demangler doesn't properly handle the arguments MR_DECL_LL*
and various other recently added macros for type specialized
procedures. It's still broken (it doesn't handle mode and label
suffixes properly), but the output is at least more readable.
Index: Mmake.common.in
===================================================================
RCS file: /home/mercury1/repository/mercury/Mmake.common.in,v
retrieving revision 1.91
diff -u -u -r1.91 Mmake.common.in
--- Mmake.common.in 15 Aug 2006 09:01:46 -0000 1.91
+++ Mmake.common.in 15 Dec 2006 05:31:25 -0000
@@ -417,9 +417,9 @@
-DMERCURY_BOOTSTRAP_H -DMR_NO_CONF_BACKWARDS_COMPAT \
-E $*.check_mhdr.c -nostdinc -dN \
2> /dev/null | $(AWK) '/[ \t]*#define/ { print $$2; }' | \
- grep -v -e `echo $(subst .check.mmacros,,$@) | tr '[a-z]' '[A-Z]'`_H | \
- grep -v -e `echo $(subst .check.mmacros,,$@) | tr '[a-z]' '[A-Z]'`_MH | \
- grep -v -e `echo $(subst .check.mmacros,,$@) | tr '[a-z]' '[A-Z]'`_DECL_GUARD | \
+ grep -v -e `echo $(subst .check.mmacros,,$@) | tr '[a-z]' '[A-Z]' | sed -e s/\\\\./__/`_H | \
+ grep -v -e `echo $(subst .check.mmacros,,$@) | tr '[a-z]' '[A-Z]' | sed -e s/\\\\./__/`_MH | \
+ grep -v -e `echo $(subst .check.mmacros,,$@) | tr '[a-z]' '[A-Z]' | sed -e s/\\\\./__/`_DECL_GUARD | \
$(HEADER_CLEAN_FILTER) | sort -u > $*.mactual
@comm -1 -3 $*.mbase $*.mactual > $@
@rm $*.mbase $*.mactual $*.mempty.c
Index: browser/browse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.67
diff -u -u -r1.67 browse.m
--- browser/browse.m 5 Dec 2006 03:20:07 -0000 1.67
+++ browser/browse.m 13 Dec 2006 11:07:52 -0000
@@ -181,6 +181,8 @@
:- import_module pair.
:- import_module pprint.
:- import_module require.
+:- import_module stream.
+:- import_module stream.string_writer.
:- import_module string.
:- import_module term_to_xml.
:- import_module type_desc.
@@ -841,8 +843,8 @@
% io.write handles the special cases such as lists, operators, etc better,
% so we prefer to use it if we can. However, io.write doesn't have
% a depth or size limit, so we need to check the size first; if the term
- % is small enough, we use io.write (actually io.write_univ), otherwise
- % we use term_to_string/4.
+ % is small enough, we use string_writer.write (actually
+ % string_writer.write_univ), otherwise we use term_to_string/4.
%
% XXX This ignores the maximum number of lines.
@@ -863,7 +865,7 @@
portray_flat_write_browser_term(plain_term(Univ), !IO) :-
io.output_stream(Stream, !IO),
- io.write_univ(Stream, include_details_cc, Univ, !IO).
+ string_writer.write_univ(Stream, include_details_cc, Univ, !IO).
portray_flat_write_browser_term(synthetic_term(Functor, Args, MaybeReturn),
!IO) :-
io.write_string(Functor, !IO),
@@ -879,7 +881,7 @@
(
MaybeReturn = yes(Return),
io.write_string(" = ", !IO),
- io.write_univ(Stream, include_details_cc, Return, !IO)
+ string_writer.write_univ(Stream, include_details_cc, Return, !IO)
;
MaybeReturn = no
).
@@ -968,7 +970,7 @@
( univ_to_type(Univ, _ `with_type` unbound) ->
io.write_char(Stream, '_', !IO)
;
- io.write_univ(Stream, include_details_cc, Univ, !IO)
+ string_writer.write_univ(Stream, include_details_cc, Univ, !IO)
).
:- pred report_deref_error(debugger::in, list(dir)::in, dir::in,
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.143
diff -u -u -r1.143 mlds.m
--- compiler/mlds.m 1 Dec 2006 15:04:09 -0000 1.143
+++ compiler/mlds.m 15 Dec 2006 00:47:39 -0000
@@ -450,7 +450,8 @@
% Is the current module a member of the std library,
% and if so which module is it?
%
-:- pred is_std_lib_module(mlds_module_name::in, string::out) is semidet.
+:- pred is_std_lib_module(mlds_module_name::in,
+ mercury_module_name::out) is semidet.
% Given an MLDS module name (e.g. `foo.bar'), append another class
% qualifier (e.g. for a class `baz'), and return the result (e.g.
@@ -1716,11 +1717,12 @@
:- import_module hlds.hlds_data.
:- import_module libs.compiler_util.
:- import_module libs.globals.
+:- import_module parse_tree.modules.
:- import_module parse_tree.prog_type.
+:- import_module parse_tree.prog_util.
:- import_module char.
:- import_module int.
-:- import_module library.
:- import_module string.
:- import_module term.
@@ -1863,20 +1865,17 @@
mercury_module_name_to_mlds(MercuryModule)
= name(MLDS_Package, MLDS_Package) :-
(
- MercuryModule = unqualified(ModuleName),
- mercury_std_library_module(ModuleName)
+ mercury_std_library_module_name(MercuryModule)
->
- MLDS_Package = qualified(unqualified("mercury"), ModuleName)
+ MLDS_Package = add_outermost_qualifier("mercury", MercuryModule)
;
MLDS_Package = MercuryModule
).
-is_std_lib_module(Module, UnqualifiedName) :-
- Name = Module ^ module_name,
- ( Name = unqualified(UnqualifiedName)
- ; Name = qualified(unqualified("mercury"), UnqualifiedName)
- ),
- mercury_std_library_module(UnqualifiedName).
+is_std_lib_module(Module, Name) :-
+ Name0 = Module ^ module_name,
+ strip_outermost_qualifier(Name0, "mercury", Name),
+ mercury_std_library_module_name(Name).
mlds_module_name_to_sym_name(Module) = Module ^ module_name.
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.204
diff -u -u -r1.204 mlds_to_c.m
--- compiler/mlds_to_c.m 1 Dec 2006 15:04:09 -0000 1.204
+++ compiler/mlds_to_c.m 14 Dec 2006 23:12:35 -0000
@@ -97,6 +97,7 @@
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
+:- import_module parse_tree.prog_util.
:- import_module bool.
:- import_module int.
@@ -231,10 +232,10 @@
% Strip off the "mercury" qualifier for standard library modules.
(
- ModuleName0 = qualified(unqualified("mercury"), ModuleName1),
- mercury_std_library_module(ModuleName1)
+ strip_outermost_qualifier(ModuleName0, "mercury", ModuleName1),
+ mercury_std_library_module_name(ModuleName1)
->
- ModuleName = unqualified(ModuleName1)
+ ModuleName = ModuleName1
;
ModuleName = ModuleName0
)
@@ -751,8 +752,8 @@
ForeignCode = mlds_foreign_code(RevHeaderCode, _RevImports,
_RevBodyCode, _ExportDefns),
HeaderCode = list.reverse(RevHeaderCode),
- ( is_std_lib_module(ModuleName, ModuleNameStr) ->
- SymName = unqualified(ModuleNameStr)
+ ( is_std_lib_module(ModuleName, StdlibModuleName) ->
+ SymName = StdlibModuleName
;
SymName = mlds_module_name_to_sym_name(ModuleName)
),
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.87
diff -u -u -r1.87 mlds_to_java.m
--- compiler/mlds_to_java.m 1 Dec 2006 15:04:10 -0000 1.87
+++ compiler/mlds_to_java.m 14 Dec 2006 22:31:04 -0000
@@ -161,8 +161,7 @@
qualified_name_is_stdlib(unqualified(_)) :- fail.
qualified_name_is_stdlib(qualified(Module, Name)) :-
(
- mercury_std_library_module(Name),
- Module = unqualified("mercury")
+ mercury_std_library_module_name(qualified(Module, Name))
;
qualified_name_is_stdlib(Module)
).
Index: compiler/mlds_to_managed.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_managed.m,v
retrieving revision 1.37
diff -u -u -r1.37 mlds_to_managed.m
--- compiler/mlds_to_managed.m 1 Dec 2006 15:04:11 -0000 1.37
+++ compiler/mlds_to_managed.m 14 Dec 2006 23:12:57 -0000
@@ -204,8 +204,8 @@
(pred(Import::in, Result::out) is det :-
( Import = mercury_import(_, Name) ->
( is_std_lib_module(Name, StdLibName) ->
- ( mercury_std_library_module_name(ModuleName) ->
- Str = StdLibName
+ ( mercury_std_library_module_name(StdLibName) ->
+ Str = sym_name_to_string(StdLibName)
;
Str = "mercury"
)
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.415
diff -u -u -r1.415 modules.m
--- compiler/modules.m 1 Dec 2006 15:04:11 -0000 1.415
+++ compiler/modules.m 14 Dec 2006 23:13:49 -0000
@@ -819,8 +819,13 @@
mercury_std_library_module_name(unqualified(Name)) :-
mercury_std_library_module(Name).
-mercury_std_library_module_name(qualified(unqualified("mercury"), Name)) :-
- mercury_std_library_module(Name).
+mercury_std_library_module_name(qualified(Module, Name)) :-
+ module_name_to_file_name(qualified(Module, Name), ModuleNameStr),
+ mercury_std_library_module(ModuleNameStr).
+mercury_std_library_module_name(qualified(Module, Name)) :-
+ strip_outermost_qualifier(qualified(Module, Name), "mercury", ModuleName),
+ module_name_to_file_name(ModuleName, ModuleNameStr),
+ mercury_std_library_module(ModuleNameStr).
module_name_to_search_file_name(ModuleName, Ext, FileName, !IO) :-
module_name_to_file_name(ModuleName, Ext, yes, no, FileName, !IO).
@@ -3710,8 +3715,7 @@
io.write_strings(DepStream,
["CSHARP_ASSEMBLY_REFS-", ForeignModuleNameString, "="], !IO),
(
- ModuleName = unqualified(Str),
- mercury_std_library_module(Str)
+ mercury_std_library_module_name(ModuleName)
->
Prefix = "/addmodule:"
;
@@ -5967,8 +5971,7 @@
% std library then replace all the std library dlls with
% one reference to mercury.dll.
(
- Module = unqualified(Str),
- mercury_std_library_module(Str)
+ mercury_std_library_module_name(Module)
->
% In the standard library we need to add the
% runtime dlls.
@@ -5978,8 +5981,7 @@
;
F = (func(M) =
(
- M = unqualified(S),
- mercury_std_library_module(S)
+ mercury_std_library_module_name(M)
->
unqualified("mercury")
;
@@ -6001,7 +6003,7 @@
submodules(Module, Modules0) = Modules :-
(
Module = unqualified(Str),
- \+ mercury_std_library_module(Str)
+ \+ mercury_std_library_module_name(Module)
->
P = (pred(M::in) is semidet :-
Str = outermost_qualifier(M),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.310
diff -u -u -r1.310 polymorphism.m
--- compiler/polymorphism.m 7 Dec 2006 15:31:12 -0000 1.310
+++ compiler/polymorphism.m 15 Dec 2006 05:12:30 -0000
@@ -401,6 +401,7 @@
:- import_module parse_tree.prog_type_subst.
:- import_module parse_tree.prog_util.
+:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module map.
@@ -2921,8 +2922,9 @@
% The first type_info will be just after the superclass infos.
First = NumSuperClasses + 1,
- type_vars_list(ClassTypes, ClassTypeVars0),
- list.map_foldl(make_index, ClassTypeVars0, ClassTypeVars, First, _),
+ Last = NumSuperClasses + ClassArity,
+ assoc_list.from_corresponding_lists(ClassTypes, First `..` Last,
+ IndexedClassTypes),
% Work out which type variables we haven't seen before, or which we
% assumed earlier would be produced in a type_info (this can happen for
@@ -2930,15 +2932,17 @@
% quantified predicates or deconstructs existentially quantified
% terms).
poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
- IsNew = (pred(TypeVar0::in) is semidet :-
- TypeVar0 = TypeVar - _Index,
+ IsNew = (pred(TypeAndIndex::in, TVarAndIndex::out) is semidet :-
+ TypeAndIndex = Type - Index,
+ Type = type_variable(TypeVar, _),
( rtti_search_type_info_locn(RttiVarMaps0, TypeVar, TypeInfoLocn) ->
TypeInfoLocn = type_info(_)
;
true
- )
+ ),
+ TVarAndIndex = TypeVar - Index
),
- list.filter(IsNew, ClassTypeVars, NewClassTypeVars),
+ list.filter_map(IsNew, IndexedClassTypes, NewClassTypeVars),
% Make an entry in the TypeInfo locations map for each new type
% variable. The type variable can be found at the previously calculated
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.97
diff -u -u -r1.97 prog_util.m
--- compiler/prog_util.m 1 Dec 2006 15:04:18 -0000 1.97
+++ compiler/prog_util.m 14 Dec 2006 23:02:26 -0000
@@ -106,6 +106,13 @@
%
:- func outermost_qualifier(sym_name) = string.
+:- func add_outermost_qualifier(string, sym_name) = sym_name.
+
+ % Remove and return the top level qualifier of a sym_name.
+ %
+:- pred strip_outermost_qualifier(sym_name::in,
+ string::out, sym_name::out) is semidet.
+
%-----------------------------------------------------------------------------%
% adjust_func_arity(PredOrFunc, FuncArity, PredArity).
@@ -316,6 +323,17 @@
outermost_qualifier(unqualified(Name)) = Name.
outermost_qualifier(qualified(Module, _Name)) = outermost_qualifier(Module).
+add_outermost_qualifier(Qual, unqualified(Name)) =
+ qualified(unqualified(Qual), Name).
+add_outermost_qualifier(Qual, qualified(Module, Name)) =
+ qualified(add_outermost_qualifier(Qual, Module), Name).
+
+strip_outermost_qualifier(qualified(unqualified(OuterQual), Name),
+ OuterQual, unqualified(Name)).
+strip_outermost_qualifier(qualified(Module @ qualified(_, _), Name),
+ OuterQual, qualified(RemainingQual, Name)) :-
+ strip_outermost_qualifier(Module, OuterQual, RemainingQual).
+
%-----------------------------------------------------------------------------%
adjust_func_arity(predicate, Arity, Arity).
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.364
diff -u -u -r1.364 io.m
--- library/io.m 2 Nov 2006 03:01:21 -0000 1.364
+++ library/io.m 13 Dec 2006 11:07:52 -0000
@@ -1482,12 +1482,6 @@
:- pred io.set_op_table(ops.table::di, io::di, io::uo) is det.
-:- pred adjust_priority_for_assoc(ops.priority::in, ops.assoc::in,
- ops.priority::out) is det.
-
-:- pred maybe_write_paren(char::in, ops.priority::in, ops.priority::in,
- io::di, io::uo) is det.
-
%
% For use by browser/browse.m:
%
@@ -1558,19 +1552,6 @@
:- func io.binary_output_stream_info(io.stream_db, io.binary_output_stream)
= io.maybe_stream_info.
-% Predicates for writing out univs.
-
-:- pred io.write_univ(univ::in, io::di, io::uo) is det.
-
-:- pred io.write_univ(io.output_stream::in, univ::in, io::di, io::uo) is det.
-
-:- pred io.write_univ(io.output_stream, deconstruct.noncanon_handling, univ,
- io, io).
-:- mode io.write_univ(in, in(do_not_allow), in, di, uo) is det.
-:- mode io.write_univ(in, in(canonicalize), in, di, uo) is det.
-:- mode io.write_univ(in, in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io.write_univ(in, in, in, di, uo) is cc_multi.
-
%
% For use by compiler/process_util.m:
%
@@ -1594,6 +1575,7 @@
:- import_module map.
:- import_module parser.
:- import_module require.
+:- import_module stream.string_writer.
:- import_module term.
:- import_module term_io.
:- import_module type_desc.
@@ -3856,83 +3838,26 @@
"ML_io_print_to_cur_stream").
io.print(Term, !IO) :-
- io.do_print(canonicalize, Term, !IO).
-
- % NOTE: in order to ensure that the signature for the exported
- % predicate matches that expected in the runtime we actually export
- % io.print_2/4 rather than io.print/4 here.
- %
-:- pragma foreign_export("C", io.print_2(in, in, di, uo),
- "ML_io_print_to_stream").
-
-io.print(output_stream(Stream), Term, !IO) :-
- io.print_2(Stream, Term, !IO).
-
-:- pred io.print_2(io.stream::in, T::in, io::di, io::uo) is det.
+ io.output_stream(Stream, !IO),
+ stream.string_writer.print(Stream, canonicalize, Term, !IO).
-io.print_2(Stream, Term, !IO) :-
- io.print(output_stream(Stream), canonicalize, Term, !IO).
+io.print(Stream, Term, !IO) :-
+ stream.string_writer.print(Stream, canonicalize, Term, !IO).
-:- pragma foreign_export("C", io.print_2(in, in(do_not_allow), in, di, uo),
- "ML_io_print_dna_to_stream").
-:- pragma foreign_export("C", io.print_2(in, in(canonicalize), in, di, uo),
- "ML_io_print_can_to_stream").
-:- pragma foreign_export("C",
- io.print_2(in, in(include_details_cc), in, di, uo),
- "ML_io_print_cc_to_stream").
+io.print(Stream, NonCanon, Term, !IO) :-
+ stream.string_writer.print(Stream, NonCanon, Term, !IO).
-io.print(output_stream(Stream), NonCanon, Term, !IO) :-
- io.print_2(Stream, NonCanon, Term, !IO).
+io.print_cc(Term, !IO) :-
+ io.output_stream(Stream, !IO),
+ stream.string_writer.print_cc(Stream, Term, !IO).
-:- pred io.print_2(io.stream, deconstruct.noncanon_handling, T, io, io).
-:- mode io.print_2(in, in(do_not_allow), in, di, uo) is det.
-:- mode io.print_2(in, in(canonicalize), in, di, uo) is det.
-:- mode io.print_2(in, in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io.print_2(in, in, in, di, uo) is cc_multi.
-
-io.print_2(Stream, NonCanon, Term, !IO) :-
- io.set_output_stream(output_stream(Stream), OrigStream, !IO),
- io.do_print(NonCanon, Term, !IO),
- io.set_output_stream(OrigStream, _Stream, !IO).
+:- pred io.print_to_stream(io.stream::in, T::in, io::di, io::uo) is det.
-io.print_cc(Term, !IO) :-
- io.do_print(include_details_cc, Term, !IO).
+:- pragma foreign_export("C", io.print_to_stream(in, in, di, uo),
+ "ML_io_print_to_stream").
-:- pred io.do_print(deconstruct.noncanon_handling, T, io, io).
-:- mode io.do_print(in(do_not_allow), in, di, uo) is det.
-:- mode io.do_print(in(canonicalize), in, di, uo) is det.
-:- mode io.do_print(in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io.do_print(in, in, di, uo) is cc_multi.
-
-io.do_print(NonCanon, Term, !IO) :-
- % `string', `char' and `univ' are special cases for io.print
- type_to_univ(Term, Univ),
- ( univ_to_type(Univ, String) ->
- io.write_string(String, !IO)
- ; univ_to_type(Univ, Char) ->
- io.write_char(Char, !IO)
- ; univ_to_type(Univ, OrigUniv) ->
- io.write_univ(OrigUniv, !IO)
- ;
- io.print_quoted(NonCanon, Term, !IO)
- ).
-
-:- pred io.print_quoted(deconstruct.noncanon_handling, T, io, io).
-:- mode io.print_quoted(in(do_not_allow), in, di, uo) is det.
-:- mode io.print_quoted(in(canonicalize), in, di, uo) is det.
-:- mode io.print_quoted(in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io.print_quoted(in, in, di, uo) is cc_multi.
-
-io.print_quoted(NonCanon, Term, !IO) :-
- io.do_write(NonCanon, Term, !IO).
-% When we have runtime type classes membership tests, then instead
-% of io.write(Term), we will want to do something like
-% ( univ_to_type_class(Univ, Portrayable) ->
-% portray(Portrayable, !IO)
-% ;
-% ... code like io.write, but which prints the arguments
-% using io.print_quoted, rather than io.write ...
-% )
+io.print_to_stream(Stream, Term, !IO) :-
+ io.print(output_stream(Stream), canonicalize, Term, !IO).
%-----------------------------------------------------------------------------%
%
@@ -3940,474 +3865,18 @@
%
io.write(X, !IO) :-
- io.do_write(canonicalize, X, !IO).
+ io.output_stream(Stream, !IO),
+ stream.string_writer.write(Stream, canonicalize, X, !IO).
io.write(Stream, X, !IO) :-
- io.write(Stream, canonicalize, X, !IO).
+ stream.string_writer.write(Stream, canonicalize, X, !IO).
io.write(Stream, NonCanon, X, !IO) :-
- io.set_output_stream(Stream, OrigStream, !IO),
- io.do_write(NonCanon, X, !IO),
- io.set_output_stream(OrigStream, _Stream, !IO).
+ stream.string_writer.write(Stream, NonCanon, X, !IO).
io.write_cc(X, !IO) :-
- io.do_write(include_details_cc, X, !IO).
-
-:- pred io.do_write(deconstruct.noncanon_handling, T, io, io).
-:- mode io.do_write(in(do_not_allow), in, di, uo) is det.
-:- mode io.do_write(in(canonicalize), in, di, uo) is det.
-:- mode io.do_write(in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io.do_write(in, in, di, uo) is cc_multi.
-
-io.do_write(NonCanon, Term, !IO) :-
- type_to_univ(Term, Univ),
- io.do_write_univ(NonCanon, Univ, !IO).
-
-%-----------------------------------------------------------------------------%
-%
-% Various different versions of io.write_univ
-%
-
-io.write_univ(Univ, !IO) :-
- io.do_write_univ(canonicalize, Univ, !IO).
-
-io.write_univ(Stream, Univ, !IO) :-
- io.write_univ(Stream, canonicalize, Univ, !IO).
-
-io.write_univ(Stream, NonCanon, Univ, !IO) :-
- io.set_output_stream(Stream, OrigStream, !IO),
- io.do_write_univ(NonCanon, Univ, !IO),
- io.set_output_stream(OrigStream, _Stream, !IO).
-
-:- pred io.do_write_univ(deconstruct.noncanon_handling, univ, io, io).
-:- mode io.do_write_univ(in(do_not_allow), in, di, uo) is det.
-:- mode io.do_write_univ(in(canonicalize), in, di, uo) is det.
-:- mode io.do_write_univ(in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io.do_write_univ(in, in, di, uo) is cc_multi.
-
-io.do_write_univ(NonCanon, Univ, !IO) :-
- io.get_op_table(OpTable, !IO),
- io.do_write_univ_prio(NonCanon, Univ, ops.max_priority(OpTable) + 1, !IO).
-
-:- pred io.do_write_univ_prio(deconstruct.noncanon_handling, univ, ops.priority,
- io, io).
-:- mode io.do_write_univ_prio(in(do_not_allow), in, in, di, uo) is det.
-:- mode io.do_write_univ_prio(in(canonicalize), in, in, di, uo) is det.
-:- mode io.do_write_univ_prio(in(include_details_cc), in, in, di, uo)
- is cc_multi.
-:- mode io.do_write_univ_prio(in, in, in, di, uo) is cc_multi.
-
-io.do_write_univ_prio(NonCanon, Univ, Priority, !IO) :-
- % We need to special-case the builtin types:
- % int, char, float, string
- % type_info, univ, c_pointer, array
- % and private_builtin.type_info
- %
- ( univ_to_type(Univ, String) ->
- term_io.quote_string(String, !IO)
- ; univ_to_type(Univ, Char) ->
- term_io.quote_char(Char, !IO)
- ; univ_to_type(Univ, Int) ->
- io.write_int(Int, !IO)
- ; univ_to_type(Univ, Float) ->
- io.write_float(Float, !IO)
- ; univ_to_type(Univ, TypeDesc) ->
- io.write_type_desc(TypeDesc, !IO)
- ; univ_to_type(Univ, TypeCtorDesc) ->
- io.write_type_ctor_desc(TypeCtorDesc, !IO)
- ; univ_to_type(Univ, input_stream(Stream)) ->
- io.write_stream(NonCanon, Stream, Priority, !IO)
- ; univ_to_type(Univ, output_stream(Stream)) ->
- io.write_stream(NonCanon, Stream, Priority, !IO)
- ; univ_to_type(Univ, binary_input_stream(Stream)) ->
- io.write_stream(NonCanon, Stream, Priority, !IO)
- ; univ_to_type(Univ, binary_output_stream(Stream)) ->
- io.write_stream(NonCanon, Stream, Priority, !IO)
- ; univ_to_type(Univ, Stream) ->
- io.write_stream(NonCanon, Stream, Priority, !IO)
- ; univ_to_type(Univ, C_Pointer) ->
- io.write_c_pointer(C_Pointer, !IO)
- ;
- % Check if the type is array.array/1. We can't just use univ_to_type
- % here since array.array/1 is a polymorphic type.
- %
- % The calls to type_ctor_name and type_ctor_module_name are not really
- % necessary -- we could use univ_to_type in the condition instead
- % of det_univ_to_type in the body. However, this way of doing things
- % is probably more efficient in the common case when the thing being
- % printed is *not* of type array.array/1.
- %
- % The ordering of the tests here (arity, then name, then module name,
- % rather than the reverse) is also chosen for efficiency, to find
- % failure cheaply in the common cases, rather than for readability.
- %
- type_ctor_and_args(univ_type(Univ), TypeCtor, ArgTypes),
- ArgTypes = [ElemType],
- type_ctor_name(TypeCtor) = "array",
- type_ctor_module_name(TypeCtor) = "array"
- ->
- % Now that we know the element type, we can constrain the type
- % of the variable `Array' so that we can use det_univ_to_type.
-
- has_type(Elem, ElemType),
- same_array_elem_type(Array, Elem),
- det_univ_to_type(Univ, Array),
- io.write_array(Array, !IO)
- ;
- % Check if the type is private_builtin.type_info/1.
- % See the comments above for array.array/1.
-
- type_ctor_and_args(univ_type(Univ), TypeCtor, ArgTypes),
- ArgTypes = [ElemType],
- type_ctor_name(TypeCtor) = "type_info",
- type_ctor_module_name(TypeCtor) = "private_builtin"
- ->
- has_type(Elem, ElemType),
- same_private_builtin_type(PrivateBuiltinTypeInfo, Elem),
- det_univ_to_type(Univ, PrivateBuiltinTypeInfo),
- io.write_private_builtin_type_info(PrivateBuiltinTypeInfo, !IO)
- ;
- io.write_ordinary_term(NonCanon, Univ, Priority, !IO)
- ).
-
-:- pred same_array_elem_type(array(T)::unused, T::unused) is det.
-
-same_array_elem_type(_, _).
-
-:- pred same_private_builtin_type(private_builtin.type_info::unused,
- T::unused) is det.
-
-same_private_builtin_type(_, _).
-
-:- pred io.write_stream(deconstruct.noncanon_handling, io.stream,
- ops.priority, io, io).
-:- mode io.write_stream(in(do_not_allow), in, in, di, uo) is det.
-:- mode io.write_stream(in(canonicalize), in, in, di, uo) is det.
-:- mode io.write_stream(in(include_details_cc), in, in, di, uo) is cc_multi.
-:- mode io.write_stream(in, in, in, di, uo) is cc_multi.
-
-io.write_stream(NonCanon, Stream, Priority, !IO) :-
- io.get_stream_db(StreamDb, !IO),
- io.maybe_stream_info(StreamDb, Stream) = StreamInfo,
- type_to_univ(StreamInfo, StreamInfoUniv),
- io.do_write_univ_prio(NonCanon, StreamInfoUniv, Priority, !IO).
-
-:- pred io.write_ordinary_term(deconstruct.noncanon_handling, univ,
- ops.priority, io, io).
-:- mode io.write_ordinary_term(in(do_not_allow), in, in, di, uo) is det.
-:- mode io.write_ordinary_term(in(canonicalize), in, in, di, uo) is det.
-:- mode io.write_ordinary_term(in(include_details_cc), in, in, di, uo)
- is cc_multi.
-:- mode io.write_ordinary_term(in, in, in, di, uo) is cc_multi.
-
-io.write_ordinary_term(NonCanon, Univ, Priority, !IO) :-
- univ_value(Univ) = Term,
- deconstruct.deconstruct(Term, NonCanon, Functor, _Arity, Args),
- io.get_op_table(OpTable, !IO),
- (
- Functor = "[|]",
- Args = [ListHead, ListTail]
- ->
- io.write_char('[', !IO),
- io.write_arg(NonCanon, ListHead, !IO),
- io.write_list_tail(NonCanon, ListTail, !IO),
- io.write_char(']', !IO)
- ;
- Functor = "[]",
- Args = []
- ->
- io.write_string("[]", !IO)
- ;
- Functor = "{}",
- Args = [BracedHead | BracedTail]
- ->
- (
- BracedTail = [],
- io.write_string("{ ", !IO),
- io.do_write_univ(NonCanon, BracedHead, !IO),
- io.write_string(" }", !IO)
- ;
- BracedTail = [_ | _],
- io.write_char('{', !IO),
- io.write_arg(NonCanon, BracedHead, !IO),
- io.write_term_args(NonCanon, BracedTail, !IO),
- io.write_char('}', !IO)
- )
- ;
- ops.lookup_op_infos(OpTable, Functor, FirstOpInfo, OtherOpInfos)
- ->
- select_op_info_and_print(NonCanon, FirstOpInfo, OtherOpInfos,
- Priority, Functor, Args, !IO)
- ;
- io.write_functor_and_args(NonCanon, Functor, Args, !IO)
- ).
-
-:- pred select_op_info_and_print(deconstruct.noncanon_handling,
- op_info, list(op_info), ops.priority, string, list(univ), io, io) is det.
-:- mode select_op_info_and_print(in(do_not_allow), in, in, in, in, in, di, uo)
- is det.
-:- mode select_op_info_and_print(in(canonicalize), in, in, in, in, in, di, uo)
- is det.
-:- mode select_op_info_and_print(in(include_details_cc), in, in, in, in, in,
- di, uo) is cc_multi.
-:- mode select_op_info_and_print(in, in, in, in, in, in, di, uo) is cc_multi.
-
-select_op_info_and_print(NonCanon, OpInfo, OtherOpInfos, Priority,
- Functor, Args, !IO) :-
- OpInfo = op_info(OpClass, _),
- (
- OpClass = prefix(_OpAssoc),
- ( Args = [Arg] ->
- OpInfo = op_info(_, OpPriority),
- maybe_write_paren('(', Priority, OpPriority, !IO),
- term_io.quote_atom(Functor, !IO),
- io.write_char(' ', !IO),
- OpClass = prefix(OpAssoc),
- adjust_priority_for_assoc(OpPriority, OpAssoc, NewPriority),
- io.do_write_univ_prio(NonCanon, Arg, NewPriority, !IO),
- maybe_write_paren(')', Priority, OpPriority, !IO)
- ;
- select_remaining_op_info_and_print(NonCanon, OtherOpInfos,
- Priority, Functor, Args, !IO)
- )
- ;
- OpClass = postfix(_OpAssoc),
- ( Args = [PostfixArg] ->
- OpInfo = op_info(_, OpPriority),
- maybe_write_paren('(', Priority, OpPriority, !IO),
- OpClass = postfix(OpAssoc),
- adjust_priority_for_assoc(OpPriority, OpAssoc, NewPriority),
- io.do_write_univ_prio(NonCanon, PostfixArg, NewPriority, !IO),
- io.write_char(' ', !IO),
- term_io.quote_atom(Functor, !IO),
- maybe_write_paren(')', Priority, OpPriority, !IO)
- ;
- select_remaining_op_info_and_print(NonCanon, OtherOpInfos,
- Priority, Functor, Args, !IO)
- )
- ;
- OpClass = infix(_LeftAssoc, _RightAssoc),
- ( Args = [Arg1, Arg2] ->
- OpInfo = op_info(_, OpPriority),
- maybe_write_paren('(', Priority, OpPriority, !IO),
- OpClass = infix(LeftAssoc, _),
- adjust_priority_for_assoc(OpPriority, LeftAssoc, LeftPriority),
- io.do_write_univ_prio(NonCanon, Arg1, LeftPriority, !IO),
- ( Functor = "," ->
- io.write_string(", ", !IO)
- ;
- io.write_char(' ', !IO),
- term_io.quote_atom(Functor, !IO),
- io.write_char(' ', !IO)
- ),
- OpClass = infix(_, RightAssoc),
- adjust_priority_for_assoc(OpPriority, RightAssoc, RightPriority),
- io.do_write_univ_prio(NonCanon, Arg2, RightPriority, !IO),
- maybe_write_paren(')', Priority, OpPriority, !IO)
- ;
- select_remaining_op_info_and_print(NonCanon, OtherOpInfos,
- Priority, Functor, Args, !IO)
- )
- ;
- OpClass = binary_prefix(_FirstAssoc, _SecondAssoc),
- ( Args = [Arg1, Arg2] ->
- OpInfo = op_info(_, OpPriority),
- maybe_write_paren('(', Priority, OpPriority, !IO),
- term_io.quote_atom(Functor, !IO),
- io.write_char(' ', !IO),
- OpClass = binary_prefix(FirstAssoc, _),
- adjust_priority_for_assoc(OpPriority, FirstAssoc,
- FirstPriority),
- io.do_write_univ_prio(NonCanon, Arg1, FirstPriority, !IO),
- io.write_char(' ', !IO),
- OpClass = binary_prefix(_, SecondAssoc),
- adjust_priority_for_assoc(OpPriority, SecondAssoc,
- SecondPriority),
- io.do_write_univ_prio(NonCanon, Arg2, SecondPriority, !IO),
- maybe_write_paren(')', Priority, OpPriority, !IO)
- ;
- select_remaining_op_info_and_print(NonCanon, OtherOpInfos,
- Priority, Functor, Args, !IO)
- )
- ).
-
-:- pred select_remaining_op_info_and_print(deconstruct.noncanon_handling,
- list(op_info), ops.priority, string, list(univ), io, io) is det.
-:- mode select_remaining_op_info_and_print(in(do_not_allow), in, in, in, in,
- di, uo) is det.
-:- mode select_remaining_op_info_and_print(in(canonicalize), in, in, in, in,
- di, uo) is det.
-:- mode select_remaining_op_info_and_print(in(include_details_cc), in, in, in,
- in, di, uo) is cc_multi.
-:- mode select_remaining_op_info_and_print(in, in, in, in, in, di, uo)
- is cc_multi.
-
-select_remaining_op_info_and_print(NonCanon, [FirstOpInfo | MoreOpInfos],
- Priority, Functor, Args, !IO) :-
- select_op_info_and_print(NonCanon, FirstOpInfo, MoreOpInfos,
- Priority, Functor, Args, !IO).
-select_remaining_op_info_and_print(NonCanon, [],
- Priority, Functor, Args, !IO) :-
- io.get_op_table(OpTable, !IO),
- (
- Args = [],
- Priority =< ops.max_priority(OpTable)
- ->
- io.write_char('(', !IO),
- term_io.quote_atom(Functor, !IO),
- io.write_char(')', !IO)
- ;
- io.write_functor_and_args(NonCanon, Functor, Args, !IO)
- ).
-
-:- pred io.write_functor_and_args(deconstruct.noncanon_handling, string,
- list(univ), io, io).
-:- mode io.write_functor_and_args(in(do_not_allow), in, in, di, uo) is det.
-:- mode io.write_functor_and_args(in(canonicalize), in, in, di, uo) is det.
-:- mode io.write_functor_and_args(in(include_details_cc), in, in, di, uo)
- is cc_multi.
-:- mode io.write_functor_and_args(in, in, in, di, uo) is cc_multi.
-
-:- pragma inline(io.write_functor_and_args/5).
-
-io.write_functor_and_args(NonCanon, Functor, Args, !IO) :-
- term_io.quote_atom_agt(Functor, maybe_adjacent_to_graphic_token, !IO),
- (
- Args = [X | Xs],
- io.write_char('(', !IO),
- io.write_arg(NonCanon, X, !IO),
- io.write_term_args(NonCanon, Xs, !IO),
- io.write_char(')', !IO)
- ;
- Args = []
- ).
-
-:- pragma inline(adjust_priority_for_assoc/3).
-
-adjust_priority_for_assoc(Priority, y, Priority).
-adjust_priority_for_assoc(Priority, x, Priority - 1).
-
-:- pragma inline(maybe_write_paren/5).
-
-maybe_write_paren(Char, Priority, OpPriority, !IO) :-
- ( OpPriority > Priority ->
- io.write_char(Char, !IO)
- ;
- true
- ).
-
-:- pred io.write_list_tail(deconstruct.noncanon_handling, univ, io, io).
-:- mode io.write_list_tail(in(do_not_allow), in, di, uo) is det.
-:- mode io.write_list_tail(in(canonicalize), in, di, uo) is det.
-:- mode io.write_list_tail(in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io.write_list_tail(in, in, di, uo) is cc_multi.
-
-io.write_list_tail(NonCanon, Univ, !IO) :-
- Term = univ_value(Univ),
- deconstruct.deconstruct(Term, NonCanon, Functor, _Arity, Args),
- (
- Functor = "[|]",
- Args = [ListHead, ListTail]
- ->
- io.write_string(", ", !IO),
- io.write_arg(NonCanon, ListHead, !IO),
- io.write_list_tail(NonCanon, ListTail, !IO)
- ;
- Functor = "[]",
- Args = []
- ->
- true
- ;
- io.write_string(" | ", !IO),
- io.do_write_univ(NonCanon, Univ, !IO)
- ).
-
- % Write the remaining arguments.
- %
-:- pred io.write_term_args(deconstruct.noncanon_handling, list(univ),
- io, io).
-:- mode io.write_term_args(in(do_not_allow), in, di, uo) is det.
-:- mode io.write_term_args(in(canonicalize), in, di, uo) is det.
-:- mode io.write_term_args(in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io.write_term_args(in, in, di, uo) is cc_multi.
-
-io.write_term_args(_, [], !IO).
-io.write_term_args(NonCanon, [X | Xs], !IO) :-
- io.write_string(", ", !IO),
- io.write_arg(NonCanon, X, !IO),
- io.write_term_args(NonCanon, Xs, !IO).
-
-:- pred io.write_arg(deconstruct.noncanon_handling, univ, io, io).
-:- mode io.write_arg(in(do_not_allow), in, di, uo) is det.
-:- mode io.write_arg(in(canonicalize), in, di, uo) is det.
-:- mode io.write_arg(in(include_details_cc), in, di, uo) is cc_multi.
-:- mode io.write_arg(in, in, di, uo) is cc_multi.
-
-io.write_arg(NonCanon, X, !IO) :-
- arg_priority(ArgPriority, !IO),
- io.do_write_univ_prio(NonCanon, X, ArgPriority, !IO).
-
-:- pred arg_priority(int::out, io::di, io::uo) is det.
-
-% arg_priority(ArgPriority, !IO) :-
-% io.get_op_table(OpTable, !IO),
-% ( ops.lookup_infix_op(OpTable, ",", Priority, _, _) ->
-% ArgPriority = Priority
-% ;
-% error("arg_priority: can't find the priority of `,'")
-% ).
-%
-% We could implement this as above, but it's more efficient to just
-% hard-code it.
-arg_priority(1000, !IO).
-
-%-----------------------------------------------------------------------------%
-
-:- pred io.write_type_desc(type_desc::in, io::di, io::uo) is det.
-
-io.write_type_desc(TypeDesc, !IO) :-
- io.write_string(type_name(TypeDesc), !IO).
-
-:- pred io.write_type_ctor_desc(type_ctor_desc::in, io::di, io::uo) is det.
-
-io.write_type_ctor_desc(TypeCtorDesc, !IO) :-
- type_ctor_name_and_arity(TypeCtorDesc, ModuleName, Name, Arity0),
- (
- ModuleName = "builtin",
- Name = "func"
- ->
- % The type ctor that we call `builtin:func/N' takes N + 1
- % type parameters: N arguments plus one return value.
- % So we need to subtract one from the arity here.
- Arity = Arity0 - 1
- ;
- Arity = Arity0
- ),
- ( ModuleName = "builtin" ->
- io.format("%s/%d", [s(Name), i(Arity)], !IO)
- ;
- io.format("%s.%s/%d", [s(ModuleName), s(Name), i(Arity)], !IO)
- ).
-
-:- pred io.write_c_pointer(c_pointer::in, io::di, io::uo) is det.
-
-io.write_c_pointer(C_Pointer, !IO) :-
- io.write_string(c_pointer_to_string(C_Pointer), !IO).
-
-:- pred io.write_array(array(T)::in, io::di, io::uo) is det.
-
-io.write_array(Array, !IO) :-
- io.write_string("array(", !IO),
- array.to_list(Array, List),
- io.write(List, !IO),
- io.write_string(")", !IO).
-
-:- pred io.write_private_builtin_type_info(private_builtin.type_info::in,
- io::di, io::uo) is det.
-
-io.write_private_builtin_type_info(PrivateBuiltinTypeInfo, !IO) :-
- TypeInfo = rtti_implementation.unsafe_cast(PrivateBuiltinTypeInfo),
- io.write_type_desc(TypeInfo, !IO).
+ io.output_stream(Stream, !IO),
+ stream.string_writer.write(Stream, include_details_cc, X, !IO).
%-----------------------------------------------------------------------------%
@@ -9100,7 +8569,7 @@
:- instance stream.writer(io.output_stream, univ, io)
where
[
- pred(put/4) is io.write_univ
+ pred(put/4) is stream.string_writer.write_univ
].
:- instance stream.line_oriented(io.output_stream, io) where
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.98
diff -u -u -r1.98 library.m
--- library/library.m 26 Oct 2006 05:13:53 -0000 1.98
+++ library/library.m 14 Dec 2006 04:48:44 -0000
@@ -256,6 +256,7 @@
mercury_std_library_module("std_util").
mercury_std_library_module("store").
mercury_std_library_module("stream").
+mercury_std_library_module("stream.string_writer").
mercury_std_library_module("string").
mercury_std_library_module("svarray").
mercury_std_library_module("svbag").
Index: library/ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/ops.m,v
retrieving revision 1.67
diff -u -u -r1.67 ops.m
--- library/ops.m 23 Oct 2006 00:32:58 -0000 1.67
+++ library/ops.m 13 Dec 2006 11:07:52 -0000
@@ -148,10 +148,21 @@
% The old names are no longer appropriate.
:- type ops.table == ops.mercury_op_table.
+%
+% For use by parser.m, term_io.m, stream.string_writer.m.
+%
+
+:- pred adjust_priority_for_assoc(ops.priority::in, ops.assoc::in,
+ ops.priority::out) is det.
+
+:- func ops.mercury_max_priority(mercury_op_table) = ops.priority.
+
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module int.
+
:- type ops.mercury_op_table
---> ops.mercury_op_table.
@@ -265,8 +276,6 @@
% Left associative, lower priority than everything except record syntax.
ops.lookup_mercury_operator_term(_OpTable, 120, y, x).
-:- func ops.mercury_max_priority(mercury_op_table) = ops.priority.
-
ops.mercury_max_priority(_Table) = 1200.
:- func ops.mercury_arg_priority(mercury_op_table) = ops.priority.
@@ -447,3 +456,10 @@
).
%-----------------------------------------------------------------------------%
+
+:- pragma inline(adjust_priority_for_assoc/3).
+
+adjust_priority_for_assoc(Priority, y, Priority).
+adjust_priority_for_assoc(Priority, x, Priority - 1).
+
+%-----------------------------------------------------------------------------%
Index: library/stream.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/stream.m,v
retrieving revision 1.3
diff -u -u -r1.3 stream.m
--- library/stream.m 9 Nov 2006 00:47:25 -0000 1.3
+++ library/stream.m 13 Dec 2006 11:07:52 -0000
@@ -24,6 +24,8 @@
:- import_module list.
:- import_module string.
+:- include_module string_writer.
+
%-----------------------------------------------------------------------------%
%
% Types used by streams
@@ -278,14 +280,9 @@
%-----------------------------------------------------------------------------%
%
-% Misc. operations on streams
+% Misc. operations on input streams
%
- % A version of io.format that works for arbitrary string writers.
- %
-:- pred stream.format(Stream::in, string::in, list(poly_type)::in,
- State::di, State::uo) is det <= stream.writer(Stream, string, State).
-
% Discard all the whitespace from the specified stream.
%
:- pred stream.ignore_whitespace(Stream::in, stream.result(Error)::out,
@@ -293,6 +290,24 @@
is det <= stream.putback(Stream, char, State, Error).
%-----------------------------------------------------------------------------%
+%
+% Misc. operations on output streams
+%
+
+ % put_list(Stream, Write, Sep, List, !State).
+ %
+ % Write all the elements List to Stream separated by Sep.
+:- pred put_list(Stream, pred(Stream, T, State, State),
+ pred(Stream, State, State), list(T), State, State)
+ <= stream.output(Stream, State).
+:- mode put_list(in, pred(in, in, di, uo) is det, pred(in, di, uo) is det,
+ in, di, uo) is det.
+:- mode put_list(in, pred(in, in, di, uo) is cc_multi,
+ pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
+:- mode put_list(in, pred(in, in, di, uo) is cc_multi,
+ pred(in, di, uo) is det, in, di, uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -371,12 +386,6 @@
).
%-----------------------------------------------------------------------------%
-
-stream.format(Stream, FormatString, Arguments, !State) :-
- string.format(FormatString, Arguments, String),
- put(Stream, String, !State).
-
-%-----------------------------------------------------------------------------%
stream.ignore_whitespace(Stream, Result, !State) :-
get(Stream, CharResult, !State),
@@ -395,7 +404,20 @@
Result = ok
)
).
-
+
+%-----------------------------------------------------------------------------%
+
+put_list(_Stream, _Pred, _Sep, [], !State).
+put_list(Stream, Pred, Sep, [X | Xs], !State) :-
+ Pred(Stream, X, !State),
+ (
+ Xs = []
+ ;
+ Xs = [_ | _],
+ Sep(Stream, !State),
+ put_list(Stream, Pred, Sep, Xs, !State)
+ ).
+
%-----------------------------------------------------------------------------%
:- end_module stream.
%-----------------------------------------------------------------------------%
Index: library/stream.string_writer.m
===================================================================
RCS file: library/stream.string_writer.m
diff -N library/stream.string_writer.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/stream.string_writer.m 13 Dec 2006 11:11:09 -0000
@@ -0,0 +1,793 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2006 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: stream.string_writer.m.
+% Authors: trd, fjh, stayl
+%
+% Predicates to write to streams that accept strings.
+%-----------------------------------------------------------------------------%
+:- module stream.string_writer.
+
+:- interface.
+
+:- import_module deconstruct.
+:- import_module univ.
+:- import_module char.
+:- import_module list.
+:- import_module string.
+:- import_module io.
+
+:- pred put_int(Stream::in, int::in, State::di, State::uo) is det
+ <= stream.writer(Stream, string, State).
+
+:- pred put_float(Stream::in, float::in, State::di, State::uo) is det
+ <= stream.writer(Stream, string, State).
+
+:- pred put_char(Stream::in, char::in, State::di, State::uo) is det
+ <= stream.writer(Stream, string, State).
+
+ % A version of io.format that works for arbitrary string writers.
+ %
+:- pred format(Stream::in, string::in, list(string.poly_type)::in,
+ State::di, State::uo) is det <= stream.writer(Stream, string, State).
+
+:- pred nl(Stream::in, State::di, State::uo) is det
+ <= stream.writer(Stream, string, State).
+
+ % print/3 writes its argument to the standard output stream.
+ % print/4 writes its second argument to the output stream specified
+ % in its first argument. In all cases, the argument to output can be
+ % of any type. It is output in a format that is intended to be human
+ % readable.
+ %
+ % If the argument is just a single string or character, it will be printed
+ % out exactly as is (unquoted). If the argument is of type univ, then
+ % it will print out the value stored in the univ, but not the type.
+ %
+ % print/5 is the same as print/4 except that it allows the caller
+ % to specify how non-canonical types should be handled. print/3 and
+ % print/4 implicitly specify `canonicalize' as the method for handling
+ % non-canonical types. This means that for higher-order types, or types
+ % with user-defined equality axioms, or types defined using the foreign
+ % language interface (i.e. pragma foreign_type), the text output will
+ % only describe the type that is being printed, not the value.
+ %
+ % print_cc/3 is the same as print/3 except that it specifies
+ % `include_details_cc' rather than `canonicalize'. This means that it will
+ % print the details of non-canonical types. However, it has determinism
+ % `cc_multi'.
+ %
+ % Note that even if `include_details_cc' is specified, some implementations
+ % may not be able to print all the details for higher-order types or types
+ % defined using the foreign language interface.
+ %
+:- pred print(Stream::in, T::in, State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
+:- pred print(Stream, deconstruct.noncanon_handling, T, State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode print(in, in(do_not_allow), in, di, uo) is det.
+:- mode print(in, in(canonicalize), in, di, uo) is det.
+:- mode print(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode print(in, in, in, di, uo) is cc_multi.
+
+:- pred print_cc(Stream::in, T::in, State::di, State::uo) is cc_multi
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
+ % write/4 writes its second argument to the output stream specified
+ % in its first argument. In all cases, the argument to output may be
+ % of any type. The argument is written in a format that is intended to
+ % be valid Mercury syntax whenever possible.
+ %
+ % Strings and characters are always printed out in quotes, using backslash
+ % escapes if necessary. For higher-order types, or for types defined
+ % using the foreign language interface (pragma foreign_code), the text
+ % output will only describe the type that is being printed, not the value,
+ % and the result may not be parsable by `read'. For the types
+ % containing existential quantifiers, the type `type_desc' and closure
+ % types, the result may not be parsable by `read', either. But in all
+ % other cases the format used is standard Mercury syntax, and if you append
+ % a period and newline (".\n"), then the results can be read in again
+ % using `read'.
+ %
+ % write/5 is the same as write/4 except that it allows the caller
+ % to specify how non-canonical types should be handled. write_cc/4
+ % is the same as write/4 except that it specifies `include_details_cc'
+ % rather than `canonicalize'.
+ %
+:- pred write(Stream::in, T::in, State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
+:- pred write(Stream, deconstruct.noncanon_handling, T, State, State) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode write(in, in(do_not_allow), in, di, uo) is det.
+:- mode write(in, in(canonicalize), in, di, uo) is det.
+:- mode write(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode write(in, in, in, di, uo) is cc_multi.
+
+:- pred write_cc(Stream::in, T::in, State::di, State::uo) is cc_multi
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- interface.
+
+:- import_module ops.
+
+%
+% For use by term_io.m
+%
+
+:- pred maybe_write_paren(Stream::in, char::in, ops.priority::in,
+ ops.priority::in, State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- pragma type_spec(maybe_write_paren/6,
+ (Stream = io.output_stream, State = io.state)).
+
+%
+% For use by browser/browse.m
+%
+
+% Predicates for writing out univs.
+
+:- pred write_univ(Stream::in, univ::in, State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
+:- pred write_univ(Stream, deconstruct.noncanon_handling,
+ univ, State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode write_univ(in, in(do_not_allow), in, di, uo) is det.
+:- mode write_univ(in, in(canonicalize), in, di, uo) is det.
+:- mode write_univ(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode write_univ(in, in, in, di, uo) is cc_multi.
+
+:- pragma type_spec(write/4, (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(write/5, (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(write_univ/4,
+ (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(write_univ/5,
+ (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(put_int/4, (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(put_float/4, (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(put_char/4, (Stream = io.output_stream, State = io.state)).
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module array.
+:- import_module int.
+:- import_module io.
+:- import_module require.
+:- import_module rtti_implementation.
+:- import_module string.
+:- import_module term_io.
+:- import_module type_desc.
+:- import_module univ.
+
+put_int(Stream, Int, !State) :-
+ (
+ % Handle the common I/O case more efficiently.
+ dynamic_cast(!.State, IOState0),
+ dynamic_cast(Stream, IOStream)
+ ->
+ io.write_int(IOStream, Int, unsafe_promise_unique(IOState0), IOState),
+ ( dynamic_cast(IOState, !:State) ->
+ !:State = unsafe_promise_unique(!.State)
+ ;
+ error("stream.string_writer.put_int: unexpected type error")
+ )
+ ;
+ put(Stream, string.int_to_string(Int), !State)
+ ).
+
+put_float(Stream, Float, !State) :-
+ (
+ % Handle the common I/O case more efficiently.
+ dynamic_cast(!.State, IOState0),
+ dynamic_cast(Stream, IOStream)
+ ->
+ io.write_float(IOStream, Float,
+ unsafe_promise_unique(IOState0), IOState),
+ ( dynamic_cast(IOState, !:State) ->
+ !:State = unsafe_promise_unique(!.State)
+ ;
+ error("stream.string_writer.put_float: unexpected type error")
+ )
+ ;
+ put(Stream, string.float_to_string(Float), !State)
+ ).
+
+put_char(Stream, Char, !State) :-
+ (
+ % Handle the common I/O case more efficiently.
+ dynamic_cast(!.State, IOState0),
+ dynamic_cast(Stream, IOStream)
+ ->
+ io.write_char(IOStream, Char,
+ unsafe_promise_unique(IOState0), IOState),
+ ( dynamic_cast(IOState, !:State) ->
+ !:State = unsafe_promise_unique(!.State)
+ ;
+ error("stream.string_writer.put_char: unexpected type error")
+ )
+ ;
+ put(Stream, string.char_to_string(Char), !State)
+ ).
+
+format(Stream, FormatString, Arguments, !State) :-
+ string.format(FormatString, Arguments, String),
+ put(Stream, String, !State).
+
+nl(Stream, !State) :-
+ put(Stream, "\n", !State).
+
+%-----------------------------------------------------------------------------%
+%
+% Various different versions of print
+%
+
+print(Stream, Term, !State) :-
+ print(Stream, canonicalize, Term, !State).
+
+print_cc(Stream, Term, !State) :-
+ print(Stream, include_details_cc, Term, !State).
+
+print(Stream, NonCanon, Term, !State) :-
+ % `string', `char' and `univ' are special cases for print
+ ( dynamic_cast(Term, String : string) ->
+ put(Stream, String, !State)
+ ; dynamic_cast(Term, Char : char) ->
+ put(Stream, Char, !State)
+ ; dynamic_cast(Term, OrigUniv) ->
+ write_univ(Stream, OrigUniv, !State)
+ ;
+ print_quoted(Stream, NonCanon, Term, !State)
+ ).
+
+:- pred print_quoted(Stream, deconstruct.noncanon_handling, T, State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode print_quoted(in, in(do_not_allow), in, di, uo) is det.
+:- mode print_quoted(in, in(canonicalize), in, di, uo) is det.
+:- mode print_quoted(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode print_quoted(in, in, in, di, uo) is cc_multi.
+
+print_quoted(Stream, NonCanon, Term, !State) :-
+ write(Stream, NonCanon, Term, !State).
+% When we have runtime type classes membership tests, then instead
+% of write(Term), we will want to do something like
+% ( univ_to_type_class(Univ, Portrayable) ->
+% portray(Stream, Portrayable, !State)
+% ;
+% ... code like write, but which prints the arguments
+% using print_quoted, rather than write ...
+% )
+
+%-----------------------------------------------------------------------------%
+%
+% Various different versions of write
+%
+
+write(Stream, X, !State) :-
+ write(Stream, canonicalize, X, !State).
+
+write_cc(Stream, X, !State) :-
+ write(Stream, include_details_cc, X, !State).
+
+write(Stream, NonCanon, Term, !State) :-
+ type_to_univ(Term, Univ),
+ do_write_univ(Stream, NonCanon, Univ, !State).
+
+%-----------------------------------------------------------------------------%
+%
+% Various different versions of write_univ
+%
+
+write_univ(Stream, Univ, !State) :-
+ do_write_univ(Stream, canonicalize, Univ, !State).
+
+write_univ(Stream, NonCanon, Univ, !State) :-
+ do_write_univ(Stream, NonCanon, Univ, !State).
+
+:- pred do_write_univ(Stream, deconstruct.noncanon_handling, univ,
+ State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode do_write_univ(in, in(do_not_allow), in, di, uo) is det.
+:- mode do_write_univ(in, in(canonicalize), in, di, uo) is det.
+:- mode do_write_univ(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode do_write_univ(in, in, in, di, uo) is cc_multi.
+:- pragma type_spec(do_write_univ/5,
+ (Stream = io.output_stream, State = io.state)).
+
+do_write_univ(Stream, NonCanon, Univ, !State) :-
+ do_write_univ_prio(Stream, NonCanon, Univ,
+ ops.mercury_max_priority(ops.init_mercury_op_table) + 1, !State).
+
+:- pred do_write_univ_prio(Stream, deconstruct.noncanon_handling, univ,
+ ops.priority, State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode do_write_univ_prio(in, in(do_not_allow), in, in, di, uo) is det.
+:- mode do_write_univ_prio(in, in(canonicalize), in, in, di, uo) is det.
+:- mode do_write_univ_prio(in, in(include_details_cc), in, in, di, uo)
+ is cc_multi.
+:- mode do_write_univ_prio(in, in, in, in, di, uo) is cc_multi.
+:- pragma type_spec(do_write_univ_prio/6,
+ (Stream = io.output_stream, State = io.state)).
+
+do_write_univ_prio(Stream, NonCanon, Univ, Priority, !State) :-
+ % We need to special-case the builtin types:
+ % int, char, float, string
+ % type_info, univ, c_pointer, array
+ % and private_builtin.type_info
+ %
+ ( univ_to_type(Univ, String) ->
+ term_io.quote_string(Stream, String, !State)
+ ; univ_to_type(Univ, Char) ->
+ term_io.quote_char(Stream, Char, !State)
+ ; univ_to_type(Univ, Int) ->
+ put_int(Stream, Int, !State)
+ ; univ_to_type(Univ, Float) ->
+ put_float(Stream, Float, !State)
+ ; univ_to_type(Univ, TypeDesc) ->
+ write_type_desc(Stream, TypeDesc, !State)
+ ; univ_to_type(Univ, TypeCtorDesc) ->
+ write_type_ctor_desc(Stream, TypeCtorDesc, !State)
+ ; univ_to_type(Univ, C_Pointer) ->
+ write_c_pointer(Stream, C_Pointer, !State)
+ ; univ_to_type(Univ, IOStream) ->
+ write_io_stream(Stream, NonCanon, io.input_stream_info,
+ IOStream, Priority, !State)
+ ; univ_to_type(Univ, IOStream) ->
+ write_io_stream(Stream, NonCanon, io.output_stream_info,
+ IOStream, Priority, !State)
+ ; univ_to_type(Univ, IOStream) ->
+ write_io_stream(Stream, NonCanon, io.binary_input_stream_info,
+ IOStream, Priority, !State)
+ ; univ_to_type(Univ, IOStream) ->
+ write_io_stream(Stream, NonCanon, io.binary_output_stream_info,
+ IOStream, Priority, !State)
+ ;
+ % Check if the type is array.array/1. We can't just use univ_to_type
+ % here since array.array/1 is a polymorphic type.
+ %
+ % The calls to type_ctor_name and type_ctor_module_name are not really
+ % necessary -- we could use univ_to_type in the condition instead
+ % of det_univ_to_type in the body. However, this way of doing things
+ % is probably more efficient in the common case when the thing being
+ % printed is *not* of type array.array/1.
+ %
+ % The ordering of the tests here (arity, then name, then module name,
+ % rather than the reverse) is also chosen for efficiency, to find
+ % failure cheaply in the common cases, rather than for readability.
+ %
+ type_ctor_and_args(univ_type(Univ), TypeCtor, ArgTypes),
+ ArgTypes = [ElemType],
+ type_ctor_name(TypeCtor) = "array",
+ type_ctor_module_name(TypeCtor) = "array"
+ ->
+ % Now that we know the element type, we can constrain the type
+ % of the variable `Array' so that we can use det_univ_to_type.
+
+ has_type(Elem, ElemType),
+ same_array_elem_type(Array, Elem),
+ det_univ_to_type(Univ, Array),
+ write_array(Stream, Array, !State)
+ ;
+ % Check if the type is private_builtin.type_info/1.
+ % See the comments above for array.array/1.
+
+ type_ctor_and_args(univ_type(Univ), TypeCtor, ArgTypes),
+ ArgTypes = [ElemType],
+ type_ctor_name(TypeCtor) = "type_info",
+ type_ctor_module_name(TypeCtor) = "private_builtin"
+ ->
+ has_type(Elem, ElemType),
+ same_private_builtin_type(PrivateBuiltinTypeInfo, Elem),
+ det_univ_to_type(Univ, PrivateBuiltinTypeInfo),
+ write_private_builtin_type_info(Stream, PrivateBuiltinTypeInfo, !State)
+ ;
+ write_ordinary_term(Stream, NonCanon, Univ, Priority, !State)
+ ).
+
+:- pred write_io_stream(Stream, deconstruct.noncanon_handling,
+ (func(io.stream_db, T) = io.maybe_stream_info), T, ops.priority,
+ State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode write_io_stream(in, in(do_not_allow), (func(in, in) = out is det),
+ in, in, di, uo) is det.
+:- mode write_io_stream(in, in(canonicalize), (func(in, in) = out is det),
+ in, in, di, uo) is det.
+:- mode write_io_stream(in, in(include_details_cc),
+ (func(in, in) = out is det), in, in, di, uo) is cc_multi.
+:- mode write_io_stream(in, in, (func(in, in) = out is det),
+ in, in, di, uo) is cc_multi.
+
+write_io_stream(Stream, NonCanon, GetStreamInfo, IOStream, Priority, !State) :-
+ ( dynamic_cast(!.State, IOState) ->
+ io.get_stream_db(StreamDb, unsafe_promise_unique(IOState), _),
+ StreamInfo = GetStreamInfo(StreamDb, IOStream)
+ ;
+ StreamInfo = unknown_stream
+ ),
+ type_to_univ(StreamInfo, StreamInfoUniv),
+ do_write_univ_prio(Stream, NonCanon, StreamInfoUniv, Priority,
+ unsafe_promise_unique(!.State), !:State).
+
+:- pred same_array_elem_type(array(T)::unused, T::unused) is det.
+
+same_array_elem_type(_, _).
+
+:- pred same_private_builtin_type(private_builtin.type_info::unused,
+ T::unused) is det.
+
+same_private_builtin_type(_, _).
+
+:- pred write_ordinary_term(Stream, deconstruct.noncanon_handling, univ,
+ ops.priority, State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode write_ordinary_term(in, in(do_not_allow), in, in, di, uo) is det.
+:- mode write_ordinary_term(in, in(canonicalize), in, in, di, uo) is det.
+:- mode write_ordinary_term(in, in(include_details_cc), in, in, di, uo)
+ is cc_multi.
+:- mode write_ordinary_term(in, in, in, in, di, uo) is cc_multi.
+:- pragma type_spec(write_ordinary_term/6,
+ (Stream = io.output_stream, State = io.state)).
+
+write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) :-
+ univ_value(Univ) = Term,
+ deconstruct.deconstruct(Term, NonCanon, Functor, _Arity, Args),
+ (
+ Functor = "[|]",
+ Args = [ListHead, ListTail]
+ ->
+ put(Stream, '[', !State),
+ write_arg(Stream, NonCanon, ListHead, !State),
+ write_list_tail(Stream, NonCanon, ListTail, !State),
+ put(Stream, ']', !State)
+ ;
+ Functor = "[]",
+ Args = []
+ ->
+ put(Stream, "[]", !State)
+ ;
+ Functor = "{}",
+ Args = [BracedHead | BracedTail]
+ ->
+ (
+ BracedTail = [],
+ put(Stream, "{ ", !State),
+ do_write_univ(Stream, NonCanon, BracedHead, !State),
+ put(Stream, " }", !State)
+ ;
+ BracedTail = [_ | _],
+ put(Stream, '{', !State),
+ write_arg(Stream, NonCanon, BracedHead, !State),
+ write_term_args(Stream, NonCanon, BracedTail, !State),
+ put(Stream, '}', !State)
+ )
+ ;
+ ops.lookup_op_infos(ops.init_mercury_op_table, Functor,
+ FirstOpInfo, OtherOpInfos)
+ ->
+ select_op_info_and_print(Stream, NonCanon, FirstOpInfo, OtherOpInfos,
+ Priority, Functor, Args, !State)
+ ;
+ write_functor_and_args(Stream, NonCanon, Functor, Args, !State)
+ ).
+
+:- pred select_op_info_and_print(Stream, deconstruct.noncanon_handling,
+ op_info, list(op_info), ops.priority, string, list(univ), State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode select_op_info_and_print(in, in(do_not_allow), in, in, in, in, in,
+ di, uo) is det.
+:- mode select_op_info_and_print(in, in(canonicalize), in, in, in, in, in,
+ di, uo) is det.
+:- mode select_op_info_and_print(in, in(include_details_cc), in, in, in, in,
+ in, di, uo) is cc_multi.
+:- mode select_op_info_and_print(in, in, in, in, in, in, in,
+ di, uo) is cc_multi.
+:- pragma type_spec(select_op_info_and_print/9,
+ (Stream = io.output_stream, State = io.state)).
+
+select_op_info_and_print(Stream, NonCanon, OpInfo, OtherOpInfos, Priority,
+ Functor, Args, !State) :-
+ OpInfo = op_info(OpClass, _),
+ (
+ OpClass = prefix(_OpAssoc),
+ ( Args = [Arg] ->
+ OpInfo = op_info(_, OpPriority),
+ maybe_write_paren(Stream, '(', Priority, OpPriority, !State),
+ term_io.quote_atom(Stream, Functor, !State),
+ put(Stream, " ", !State),
+ OpClass = prefix(OpAssoc),
+ adjust_priority_for_assoc(OpPriority, OpAssoc, NewPriority),
+ do_write_univ_prio(Stream, NonCanon, Arg, NewPriority, !State),
+ maybe_write_paren(Stream, ')', Priority, OpPriority, !State)
+ ;
+ select_remaining_op_info_and_print(Stream, NonCanon, OtherOpInfos,
+ Priority, Functor, Args, !State)
+ )
+ ;
+ OpClass = postfix(_OpAssoc),
+ ( Args = [PostfixArg] ->
+ OpInfo = op_info(_, OpPriority),
+ maybe_write_paren(Stream, '(', Priority, OpPriority, !State),
+ OpClass = postfix(OpAssoc),
+ adjust_priority_for_assoc(OpPriority, OpAssoc, NewPriority),
+ do_write_univ_prio(Stream, NonCanon, PostfixArg,
+ NewPriority, !State),
+ put(Stream, " ", !State),
+ term_io.quote_atom(Stream, Functor, !State),
+ maybe_write_paren(Stream, ')', Priority, OpPriority, !State)
+ ;
+ select_remaining_op_info_and_print(Stream, NonCanon, OtherOpInfos,
+ Priority, Functor, Args, !State)
+ )
+ ;
+ OpClass = infix(_LeftAssoc, _RightAssoc),
+ ( Args = [Arg1, Arg2] ->
+ OpInfo = op_info(_, OpPriority),
+ maybe_write_paren(Stream, '(', Priority, OpPriority, !State),
+ OpClass = infix(LeftAssoc, _),
+ adjust_priority_for_assoc(OpPriority, LeftAssoc, LeftPriority),
+ do_write_univ_prio(Stream, NonCanon, Arg1, LeftPriority, !State),
+ ( Functor = "," ->
+ put(Stream, ", ", !State)
+ ;
+ put(Stream, " ", !State),
+ term_io.quote_atom(Stream, Functor, !State),
+ put(Stream, " ", !State)
+ ),
+ OpClass = infix(_, RightAssoc),
+ adjust_priority_for_assoc(OpPriority, RightAssoc, RightPriority),
+ do_write_univ_prio(Stream, NonCanon, Arg2, RightPriority, !State),
+ maybe_write_paren(Stream, ')', Priority, OpPriority, !State)
+ ;
+ select_remaining_op_info_and_print(Stream, NonCanon, OtherOpInfos,
+ Priority, Functor, Args, !State)
+ )
+ ;
+ OpClass = binary_prefix(_FirstAssoc, _SecondAssoc),
+ ( Args = [Arg1, Arg2] ->
+ OpInfo = op_info(_, OpPriority),
+ maybe_write_paren(Stream, '(', Priority, OpPriority, !State),
+ term_io.quote_atom(Stream, Functor, !State),
+ put(Stream, " ", !State),
+ OpClass = binary_prefix(FirstAssoc, _),
+ adjust_priority_for_assoc(OpPriority, FirstAssoc, FirstPriority),
+ do_write_univ_prio(Stream, NonCanon, Arg1, FirstPriority, !State),
+ put(Stream, " ", !State),
+ OpClass = binary_prefix(_, SecondAssoc),
+ adjust_priority_for_assoc(OpPriority, SecondAssoc,
+ SecondPriority),
+ do_write_univ_prio(Stream, NonCanon, Arg2, SecondPriority, !State),
+ maybe_write_paren(Stream, ')', Priority, OpPriority, !State)
+ ;
+ select_remaining_op_info_and_print(Stream, NonCanon, OtherOpInfos,
+ Priority, Functor, Args, !State)
+ )
+ ).
+
+:- pred select_remaining_op_info_and_print(Stream,
+ deconstruct.noncanon_handling, list(op_info), ops.priority, string,
+ list(univ), State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode select_remaining_op_info_and_print(in, in(do_not_allow), in, in, in,
+ in, di, uo) is det.
+:- mode select_remaining_op_info_and_print(in, in(canonicalize), in, in, in,
+ in, di, uo) is det.
+:- mode select_remaining_op_info_and_print(in(include_details_cc), in, in, in,
+ in, in, di, uo) is cc_multi.
+:- mode select_remaining_op_info_and_print(in, in, in, in, in, in, di, uo)
+ is cc_multi.
+:- pragma type_spec(select_remaining_op_info_and_print/8,
+ (Stream = io.output_stream, State = io.state)).
+
+select_remaining_op_info_and_print(Stream, NonCanon,
+ [FirstOpInfo | MoreOpInfos], Priority, Functor, Args, !State) :-
+ select_op_info_and_print(Stream, NonCanon, FirstOpInfo, MoreOpInfos,
+ Priority, Functor, Args, !State).
+select_remaining_op_info_and_print(Stream, NonCanon, [],
+ Priority, Functor, Args, !State) :-
+ (
+ Args = [],
+ Priority =< ops.mercury_max_priority(ops.init_mercury_op_table)
+ ->
+ put(Stream, '(', !State),
+ term_io.quote_atom(Stream, Functor, !State),
+ put(Stream, ')', !State)
+ ;
+ write_functor_and_args(Stream, NonCanon, Functor, Args, !State)
+ ).
+
+:- pred write_functor_and_args(Stream, deconstruct.noncanon_handling, string,
+ list(univ), State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode write_functor_and_args(in, in(do_not_allow), in, in, di, uo) is det.
+:- mode write_functor_and_args(in, in(canonicalize), in, in, di, uo) is det.
+:- mode write_functor_and_args(in, in(include_details_cc), in, in, di, uo)
+ is cc_multi.
+:- mode write_functor_and_args(in, in, in, in, di, uo) is cc_multi.
+:- pragma type_spec(write_functor_and_args/6,
+ (Stream = io.output_stream, State = io.state)).
+
+:- pragma inline(write_functor_and_args/6).
+
+write_functor_and_args(Stream, NonCanon, Functor, Args, !State) :-
+ term_io.quote_atom_agt(Stream, Functor,
+ maybe_adjacent_to_graphic_token, !State),
+ (
+ Args = [X | Xs],
+ put(Stream, '(', !State),
+ write_arg(Stream, NonCanon, X, !State),
+ write_term_args(Stream, NonCanon, Xs, !State),
+ put(Stream, ')', !State)
+ ;
+ Args = []
+ ).
+
+:- pragma inline(maybe_write_paren/6).
+
+maybe_write_paren(Stream, String, Priority, OpPriority, !State) :-
+ ( OpPriority > Priority ->
+ put(Stream, String, !State)
+ ;
+ true
+ ).
+
+:- pred write_list_tail(Stream, deconstruct.noncanon_handling, univ,
+ State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode write_list_tail(in, in(do_not_allow), in, di, uo) is det.
+:- mode write_list_tail(in, in(canonicalize), in, di, uo) is det.
+:- mode write_list_tail(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode write_list_tail(in, in, in, di, uo) is cc_multi.
+:- pragma type_spec(write_list_tail/5,
+ (Stream = io.output_stream, State = io.state)).
+
+write_list_tail(Stream, NonCanon, Univ, !State) :-
+ Term = univ_value(Univ),
+ deconstruct.deconstruct(Term, NonCanon, Functor, _Arity, Args),
+ (
+ Functor = "[|]",
+ Args = [ListHead, ListTail]
+ ->
+ put(Stream, ", ", !State),
+ write_arg(Stream, NonCanon, ListHead, !State),
+ write_list_tail(Stream, NonCanon, ListTail, !State)
+ ;
+ Functor = "[]",
+ Args = []
+ ->
+ true
+ ;
+ put(Stream, " | ", !State),
+ do_write_univ(Stream, NonCanon, Univ, !State)
+ ).
+
+ % Write the remaining arguments.
+ %
+:- pred write_term_args(Stream, deconstruct.noncanon_handling, list(univ),
+ State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode write_term_args(in, in(do_not_allow), in, di, uo) is det.
+:- mode write_term_args(in, in(canonicalize), in, di, uo) is det.
+:- mode write_term_args(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode write_term_args(in, in, in, di, uo) is cc_multi.
+:- pragma type_spec(write_term_args/5,
+ (Stream = io.output_stream, State = io.state)).
+
+write_term_args(_Stream, _, [], !State).
+write_term_args(Stream, NonCanon, [X | Xs], !State) :-
+ put(Stream, ", ", !State),
+ write_arg(Stream, NonCanon, X, !State),
+ write_term_args(Stream, NonCanon, Xs, !State).
+
+:- pred write_arg(Stream, deconstruct.noncanon_handling, univ, State, State)
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- mode write_arg(in, in(do_not_allow), in, di, uo) is det.
+:- mode write_arg(in, in(canonicalize), in, di, uo) is det.
+:- mode write_arg(in, in(include_details_cc), in, di, uo) is cc_multi.
+:- mode write_arg(in, in, in, di, uo) is cc_multi.
+:- pragma type_spec(write_arg/5,
+ (Stream = io.output_stream, State = io.state)).
+
+write_arg(Stream, NonCanon, X, !State) :-
+ arg_priority(ArgPriority, !State),
+ do_write_univ_prio(Stream, NonCanon, X, ArgPriority, !State).
+
+:- pred arg_priority(int::out, State::di, State::uo) is det.
+
+% arg_priority(ArgPriority, !State) :-
+% ( ops.lookup_infix_op(ops.init_mercury_op_table, ",", Priority, _, _) ->
+% ArgPriority = Priority
+% ;
+% error("arg_priority: can't find the priority of `,'")
+% ).
+%
+% We could implement this as above, but it's more efficient to just
+% hard-code it.
+arg_priority(1000, !State).
+
+%-----------------------------------------------------------------------------%
+
+:- pred write_type_desc(Stream::in, type_desc::in, State::di, State::uo) is det
+ <= stream.writer(Stream, string, State).
+
+write_type_desc(Stream, TypeDesc, !State) :-
+ put(Stream, type_name(TypeDesc), !State).
+
+:- pred write_type_ctor_desc(Stream::in, type_ctor_desc::in,
+ State::di, State::uo) is det <= stream.writer(Stream, string, State).
+
+write_type_ctor_desc(Stream, TypeCtorDesc, !State) :-
+ type_ctor_name_and_arity(TypeCtorDesc, ModuleName, Name, Arity0),
+ (
+ ModuleName = "builtin",
+ Name = "func"
+ ->
+ % The type ctor that we call `builtin:func/N' takes N + 1
+ % type parameters: N arguments plus one return value.
+ % So we need to subtract one from the arity here.
+ Arity = Arity0 - 1
+ ;
+ Arity = Arity0
+ ),
+ ( ModuleName = "builtin" ->
+ format(Stream, "%s/%d", [s(Name), i(Arity)], !State)
+ ;
+ format(Stream, "%s.%s/%d", [s(ModuleName), s(Name), i(Arity)], !State)
+ ).
+
+:- pred write_c_pointer(Stream::in, c_pointer::in, State::di, State::uo) is det
+ <= stream.writer(Stream, string, State).
+
+write_c_pointer(Stream, C_Pointer, !State) :-
+ put(Stream, c_pointer_to_string(C_Pointer), !State).
+
+:- pred write_array(Stream::in, array(T)::in, State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+:- pragma type_spec(write_array/4,
+ (Stream = io.output_stream, State = io.state)).
+
+write_array(Stream, Array, !State) :-
+ put(Stream, "array(", !State),
+ array.to_list(Array, List),
+ write(Stream, List, !State),
+ put(Stream, ")", !State).
+
+:- pred write_private_builtin_type_info(Stream::in,
+ private_builtin.type_info::in, State::di, State::uo) is det
+ <= stream.writer(Stream, string, State).
+
+write_private_builtin_type_info(Stream, PrivateBuiltinTypeInfo, !State) :-
+ TypeInfo = rtti_implementation.unsafe_cast(PrivateBuiltinTypeInfo),
+ write_type_desc(Stream, TypeInfo, !State).
+
+%-----------------------------------------------------------------------------%
Index: library/term_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term_io.m,v
retrieving revision 1.83
diff -u -u -r1.83 term_io.m
--- library/term_io.m 1 Nov 2006 06:33:38 -0000 1.83
+++ library/term_io.m 13 Dec 2006 11:07:52 -0000
@@ -23,6 +23,7 @@
:- import_module char.
:- import_module io.
:- import_module ops.
+:- import_module stream.
:- import_module term.
:- import_module varset.
@@ -112,6 +113,11 @@
%
:- pred term_io.quote_string(string::in, io::di, io::uo) is det.
+:- pred term_io.quote_string(Stream::in, string::in,
+ State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
% Like term_io.quote_string, but return the result in a string.
%
:- func term_io.quoted_string(string) = string.
@@ -121,6 +127,11 @@
%
:- pred term_io.quote_atom(string::in, io::di, io::uo) is det.
+:- pred term_io.quote_atom(Stream::in, string::in,
+ State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
% Like term_io.quote_atom, but return the result in a string.
%
:- func term_io.quoted_atom(string) = string.
@@ -130,6 +141,11 @@
%
:- pred term_io.quote_char(char::in, io::di, io::uo) is det.
+:- pred term_io.quote_char(Stream::in, char::in,
+ State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
% Like term_io.quote_char, but return the result in a string.
%
:- func term_io.quoted_char(char) = string.
@@ -139,6 +155,11 @@
%
:- pred term_io.write_escaped_char(char::in, io::di, io::uo) is det.
+:- pred term_io.write_escaped_char(Stream::in, char::in,
+ State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
% Like term_io.write_escaped_char, but return the result in a string.
%
:- func term_io.escaped_char(char) = string.
@@ -148,6 +169,11 @@
%
:- pred term_io.write_escaped_string(string::in, io::di, io::uo) is det.
+:- pred term_io.write_escaped_string(Stream::in, string::in,
+ State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
% Like term_io.write_escaped_char, but return the result in a string.
%
:- func term_io.escaped_string(string) = string.
@@ -188,8 +214,26 @@
:- pred term_io.quote_atom_agt(string::in, adjacent_to_graphic_token::in,
io::di, io::uo) is det.
+:- pred term_io.quote_atom_agt(Stream::in, string::in,
+ adjacent_to_graphic_token::in, State::di, State::uo) is det
+ <= (stream.writer(Stream, string, State),
+ stream.writer(Stream, char, State)).
+
:- func term_io.quoted_atom_agt(string, adjacent_to_graphic_token) = string.
+:- pragma type_spec(term_io.quote_string/4,
+ (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(term_io.quote_atom/4,
+ (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(term_io.write_escaped_string/4,
+ (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(term_io.write_escaped_char/4,
+ (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(term_io.quote_char/4,
+ (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(term_io.quote_atom_agt/5,
+ (Stream = io.output_stream, State = io.state)).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -202,6 +246,7 @@
:- import_module list.
:- import_module parser.
:- import_module string.
+:- import_module stream.string_writer.
%-----------------------------------------------------------------------------%
@@ -340,29 +385,32 @@
Functor = term.atom(OpName),
ops.lookup_prefix_op(Ops, OpName, OpPriority, OpAssoc)
->
- maybe_write_paren('(', Priority, OpPriority, !IO),
+ io.output_stream(Stream, !IO),
+ maybe_write_paren(Stream, '(', Priority, OpPriority, !IO),
term_io.write_constant(Functor, !IO),
io.write_char(' ', !IO),
adjust_priority_for_assoc(OpPriority, OpAssoc, NewPriority),
term_io.write_term_3(Ops, PrefixArg, NewPriority, !VarSet, !N, !IO),
- maybe_write_paren(')', Priority, OpPriority, !IO)
+ maybe_write_paren(Stream, ')', Priority, OpPriority, !IO)
;
Args = [PostfixArg],
Functor = term.atom(OpName),
ops.lookup_postfix_op(Ops, OpName, OpPriority, OpAssoc)
->
- maybe_write_paren('(', Priority, OpPriority, !IO),
+ io.output_stream(Stream, !IO),
+ maybe_write_paren(Stream, '(', Priority, OpPriority, !IO),
adjust_priority_for_assoc(OpPriority, OpAssoc, NewPriority),
term_io.write_term_3(Ops, PostfixArg, NewPriority, !VarSet, !N, !IO),
io.write_char(' ', !IO),
term_io.write_constant(Functor, !IO),
- maybe_write_paren(')', Priority, OpPriority, !IO)
+ maybe_write_paren(Stream, ')', Priority, OpPriority, !IO)
;
Args = [Arg1, Arg2],
Functor = term.atom(OpName),
ops.lookup_infix_op(Ops, OpName, OpPriority, LeftAssoc, RightAssoc)
->
- maybe_write_paren('(', Priority, OpPriority, !IO),
+ io.output_stream(Stream, !IO),
+ maybe_write_paren(Stream, '(', Priority, OpPriority, !IO),
adjust_priority_for_assoc(OpPriority, LeftAssoc, LeftPriority),
term_io.write_term_3(Ops, Arg1, LeftPriority, !VarSet, !N, !IO),
( OpName = "," ->
@@ -385,14 +433,15 @@
),
adjust_priority_for_assoc(OpPriority, RightAssoc, RightPriority),
term_io.write_term_3(Ops, Arg2, RightPriority, !VarSet, !N, !IO),
- maybe_write_paren(')', Priority, OpPriority, !IO)
+ maybe_write_paren(Stream, ')', Priority, OpPriority, !IO)
;
Args = [Arg1, Arg2],
Functor = term.atom(OpName),
ops.lookup_binary_prefix_op(Ops, OpName, OpPriority,
FirstAssoc, SecondAssoc)
->
- maybe_write_paren('(', Priority, OpPriority, !IO),
+ io.output_stream(Stream, !IO),
+ maybe_write_paren(Stream, '(', Priority, OpPriority, !IO),
term_io.write_constant(Functor, !IO),
io.write_char(' ', !IO),
adjust_priority_for_assoc(OpPriority, FirstAssoc, FirstPriority),
@@ -400,7 +449,7 @@
io.write_char(' ', !IO),
adjust_priority_for_assoc(OpPriority, SecondAssoc, SecondPriority),
term_io.write_term_3(Ops, Arg2, SecondPriority, !VarSet, !N, !IO),
- maybe_write_paren(')', Priority, OpPriority, !IO)
+ maybe_write_paren(Stream, ')', Priority, OpPriority, !IO)
;
(
Args = [],
@@ -518,25 +567,35 @@
term_io.quote_char(C, !IO) :-
io.write_string(term_io.quoted_char(C), !IO).
+term_io.quote_char(Stream, C, !State) :-
+ stream.put(Stream, term_io.quoted_char(C), !State).
+
term_io.quoted_char(C) =
string.format("'%s'", [s(term_io.escaped_char(C))]).
term_io.quote_atom(S, !IO) :-
term_io.quote_atom_agt(S, not_adjacent_to_graphic_token, !IO).
+term_io.quote_atom(Stream, S, !State) :-
+ term_io.quote_atom_agt(Stream, S, not_adjacent_to_graphic_token, !State).
+
term_io.quoted_atom(S) =
term_io.quoted_atom_agt(S, not_adjacent_to_graphic_token).
term_io.quote_atom_agt(S, NextToGraphicToken, !IO) :-
+ io.output_stream(Stream, !IO),
+ term_io.quote_atom_agt(Stream, S, NextToGraphicToken, !IO).
+
+term_io.quote_atom_agt(Stream, S, NextToGraphicToken, !State) :-
ShouldQuote = should_atom_be_quoted(S, NextToGraphicToken),
(
ShouldQuote = no,
- io.write_string(S, !IO)
+ stream.put(Stream, S, !State)
;
ShouldQuote = yes,
- io.write_char('''', !IO),
- term_io.write_escaped_string(S, !IO),
- io.write_char('''', !IO)
+ stream.put(Stream, '''', !State),
+ term_io.write_escaped_string(Stream, S, !State),
+ stream.put(Stream, '''', !State)
).
term_io.quoted_atom_agt(S, NextToGraphicToken) = String :-
@@ -604,28 +663,37 @@
% any changes here may require similar changes there.
term_io.quote_string(S, !IO) :-
- io.write_char('"', !IO),
- term_io.write_escaped_string(S, !IO),
- io.write_char('"', !IO).
+ io.output_stream(Stream, !IO),
+ term_io.quote_string(Stream, S, !IO).
+
+term_io.quote_string(Stream, S, !State) :-
+ stream.put(Stream, '"', !State),
+ term_io.write_escaped_string(Stream, S, !State),
+ stream.put(Stream, '"', !State).
term_io.quoted_string(S) =
string.append_list(["""", term_io.escaped_string(S), """"]).
term_io.write_escaped_string(String, !IO) :-
- string.foldl(term_io.write_escaped_char, String, !IO).
+ io.output_stream(Stream, !IO),
+ term_io.write_escaped_string(Stream, String, !IO).
+
+term_io.write_escaped_string(Stream, String, !State) :-
+ string.foldl(term_io.write_escaped_char(Stream), String, !State).
term_io.escaped_string(String) =
- string.foldl(term_io.add_escaped_char, String, "").
+ string.append_list(
+ reverse(string.foldl(term_io.add_escaped_char, String, []))).
-:- func term_io.add_escaped_char(char, string) = string.
+:- func term_io.add_escaped_char(char, list(string)) = list(string).
-term_io.add_escaped_char(Char, String0) = String :-
+term_io.add_escaped_char(Char, Strings0) = Strings :-
( mercury_escape_special_char(Char, QuoteChar) ->
- String = String0 ++ from_char_list(['\\', QuoteChar])
+ Strings = [from_char_list(['\\', QuoteChar]) | Strings0]
; is_mercury_source_char(Char) ->
- String = String0 ++ string.char_to_string(Char)
+ Strings = [string.char_to_string(Char) | Strings0]
;
- String = String0 ++ mercury_escape_char(Char)
+ Strings = [mercury_escape_char(Char) | Strings0]
).
% Note: the code of add_escaped_char and write_escaped_char should be
@@ -634,13 +702,17 @@
% similar changes there.
term_io.write_escaped_char(Char, !IO) :-
+ io.output_stream(Stream, !IO),
+ term_io.write_escaped_char(Stream, Char, !IO).
+
+term_io.write_escaped_char(Stream, Char, !State) :-
( mercury_escape_special_char(Char, QuoteChar) ->
- io.write_char('\\', !IO),
- io.write_char(QuoteChar, !IO)
+ stream.put(Stream, ('\\'), !State),
+ stream.put(Stream, QuoteChar, !State)
; is_mercury_source_char(Char) ->
- io.write_char(Char, !IO)
+ stream.put(Stream, Char, !State)
;
- io.write_string(mercury_escape_char(Char), !IO)
+ stream.put(Stream, mercury_escape_char(Char), !State)
).
term_io.escaped_char(Char) = String :-
Index: tests/hard_coded/stream_format.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/stream_format.m,v
retrieving revision 1.1
diff -u -u -r1.1 stream_format.m
--- tests/hard_coded/stream_format.m 9 Nov 2006 00:47:26 -0000 1.1
+++ tests/hard_coded/stream_format.m 15 Dec 2006 07:19:16 -0000
@@ -9,9 +9,10 @@
:- import_module list.
:- import_module stream.
+:- import_module stream.string_writer.
:- import_module string.
main(!IO) :-
io.stdout_stream(Stdout, !IO),
- stream.format(Stdout, "%s%d%c%f\n",
+ stream.string_writer.format(Stdout, "%s%d%c%f\n",
[s("foo"), i(561), c('a'), f(3.141)], !IO).
Index: tests/hard_coded/test_injection.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/test_injection.m,v
retrieving revision 1.2
diff -u -u -r1.2 test_injection.m
--- tests/hard_coded/test_injection.m 29 Mar 2006 08:08:02 -0000 1.2
+++ tests/hard_coded/test_injection.m 15 Dec 2006 04:37:41 -0000
@@ -8,7 +8,8 @@
:- import_module injection.
:- import_module int.
:- import_module list.
-:- import_module pair .
+:- import_module pair.
+:- import_module univ.
:- type test_inj == injection(int, int).
:- type test_data == assoc_list(int, int).
@@ -138,7 +139,7 @@
;
Result = exception(Univ),
io.write_string("threw exception: ", !IO),
- io.write_univ(Univ, !IO),
+ io.write(univ_value(Univ), !IO),
io.write_string("\n", !IO)
).
Index: tests/invalid/string_format_bad.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/string_format_bad.m,v
retrieving revision 1.2
diff -u -u -r1.2 string_format_bad.m
--- tests/invalid/string_format_bad.m 9 Nov 2006 00:47:27 -0000 1.2
+++ tests/invalid/string_format_bad.m 15 Dec 2006 07:26:44 -0000
@@ -14,7 +14,7 @@
:- import_module float.
:- import_module int.
:- import_module list.
-:- import_module stream.
+:- import_module stream, stream.string_writer.
:- import_module string.
main(!IO) :-
@@ -25,7 +25,7 @@
io.stdout_stream(OutputStream, !IO),
io.format("%d", [s("x3")], !IO),
io.format(OutputStream, "%d", [s("x4")], !IO),
- stream.format(OutputStream, "%d", [s("x4")], !IO),
+ stream.string_writer.format(OutputStream, "%d", [s("x4")], !IO),
io.format("%w", [i(5)], !IO),
io.write_string(p(s("five")), !IO),
F6 = "%s %f",
Index: tests/invalid/string_format_unknown.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/string_format_unknown.m,v
retrieving revision 1.2
diff -u -u -r1.2 string_format_unknown.m
--- tests/invalid/string_format_unknown.m 9 Nov 2006 00:47:27 -0000 1.2
+++ tests/invalid/string_format_unknown.m 14 Dec 2006 04:02:56 -0000
@@ -15,6 +15,7 @@
:- import_module int.
:- import_module list.
:- import_module stream.
+:- import_module stream.string_writer.
:- import_module string.
main(!IO) :-
@@ -37,7 +38,7 @@
V6 = [s("six"), V6A],
copy(V6, C6),
io.format(OutputStream, F6, C6, !IO),
- stream.format(OutputStream, F6, C6, !IO),
+ stream.string_writer.format(OutputStream, F6, C6, !IO),
make_bool(7, T7),
F7 = "%d %s %d",
(
Index: util/mdemangle.c
===================================================================
RCS file: /home/mercury1/repository/mercury/util/mdemangle.c,v
retrieving revision 1.53
diff -u -u -r1.53 mdemangle.c
--- util/mdemangle.c 21 Jun 2005 01:38:19 -0000 1.53
+++ util/mdemangle.c 13 Dec 2006 11:07:52 -0000
@@ -262,7 +262,7 @@
** making sure that we don't overflow the buffer
*/
if (strlen(orig_name) >= sizeof(name)) {
- goto wrong_format;
+ goto too_long;
}
strcpy(name, orig_name);
@@ -846,7 +846,15 @@
return;
wrong_format:
- printf("%s", orig_name);
+ strcpy(name, orig_name);
+ start = name;
+ end = name + strlen(name);
+ start = fix_mangled_ascii(start, &end);
+ printf(name);
+ return;
+
+too_long:
+ printf(orig_name);
return;
} /* end demangle() */
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list