From f1275fa6e8236e00ff139a96e5fd25dbe19ac205 Mon Sep 17 00:00:00 2001 From: Simon Taylor Date: Thu, 21 Dec 2006 11:11:37 +0000 Subject: [PATCH] Implement io.write for arbitrary streams. With type specialization 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: library/library.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: compiler/format_call.m: mdbcomp/prim_data.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 moved 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. --- Mmake.common.in | 6 +- browser/browse.m | 12 +- compiler/format_call.m | 27 +- compiler/mlds.m | 21 +- compiler/mlds_to_c.m | 11 +- compiler/mlds_to_java.m | 3 +- compiler/mlds_to_managed.m | 4 +- compiler/modules.m | 20 +- compiler/polymorphism.m | 16 +- compiler/prog_type.m | 4 +- compiler/prog_util.m | 18 + compiler/simplify.m | 2 +- library/io.m | 573 +------------------ library/library.m | 1 + library/ops.m | 20 +- library/stream.m | 48 +- library/stream.string_writer.m | 793 ++++++++++++++++++++++++++ library/term_io.m | 124 +++- mdbcomp/prim_data.m | 6 +- tests/hard_coded/stream_format.m | 3 +- tests/hard_coded/test_injection.m | 5 +- tests/invalid/string_format_bad.m | 4 +- tests/invalid/string_format_unknown.m | 3 +- util/mdemangle.c | 14 +- 24 files changed, 1078 insertions(+), 660 deletions(-) create mode 100644 library/stream.string_writer.m diff --git a/Mmake.common.in b/Mmake.common.in index 670bb6756..716ccc193 100644 --- a/Mmake.common.in +++ b/Mmake.common.in @@ -417,9 +417,9 @@ AWK = awk -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 diff --git a/browser/browse.m b/browser/browse.m index 1a18b728e..09f0c1063 100644 --- a/browser/browse.m +++ b/browser/browse.m @@ -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 @@ portray_flat(Debugger, BrowserTerm, Params, !IO) :- % 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(Debugger, BrowserTerm, Params, !IO) :- 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 @@ portray_flat_write_browser_term(synthetic_term(Functor, Args, MaybeReturn), ( 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 @@ write_univ_or_unbound(Stream, Univ, !IO) :- ( 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, diff --git a/compiler/format_call.m b/compiler/format_call.m index 32fda57ca..ed013510e 100644 --- a/compiler/format_call.m +++ b/compiler/format_call.m @@ -10,10 +10,10 @@ % Author: zs. % % The job of this module is to generate warnings about calls to -% string.format, io.format and stream.format in which the format string and -% the supplied lists of values do not agree. The difficult part of this job -% is actually finding the values of the variables representing the format -% string and the list of values to be printed. +% string.format, io.format and stream.string_writer.format in which the format +% string and the supplied lists of values do not agree. The difficult part of +% this job is actually finding the values of the variables representing the +% format string and the list of values to be printed. % % The general approach is a backwards traversal of the procedure body. During % this traversal, we assign an id to every conjunction (considering a cond and @@ -186,15 +186,22 @@ is_format_call(ModuleName, Name, Args, FormatStringVar, FormattedValuesVar) :- Name = "format", - ( ModuleName = mercury_std_lib_module_name("string") -> + ( + ModuleName = mercury_std_lib_module_name(unqualified("string")) + -> % We have these arguments regardless of whether we call the % predicate or function version of string.format. Args = [FormatStringVar, FormattedValuesVar, _ResultVar] - ; ModuleName = mercury_std_lib_module_name("io") -> + ; + ModuleName = mercury_std_lib_module_name(unqualified("io")) + -> ( Args = [FormatStringVar, FormattedValuesVar, _IOIn, _IOOut] ; Args = [_Stream, FormatStringVar, FormattedValuesVar, _IOIn, _IOOut] ) - ; ModuleName = mercury_std_lib_module_name("stream") -> + ; + ModuleName = mercury_std_lib_module_name( + qualified(unqualified("stream"), "string_writer")) + -> % Since we do this check after polymorphism there will have been % a typeclassinfo inserted at the front of the argument list. Args = [_TC_InfoForStream, _Stream, FormatStringVar, @@ -498,7 +505,8 @@ traverse_unify(Unification, CurId, !ConjMaps, !PredMap, !RelevantVars) :- ConjMap = conj_map(StringMap, ListMap0, ElementMap0, EqvMap0) ; ConsId = cons(SymName, _Arity), - StringModule = mercury_std_lib_module_name("list"), + StringModule = + mercury_std_lib_module_name(unqualified("list")), SymName = qualified(StringModule, Functor), ( Functor = "[|]", @@ -517,7 +525,8 @@ traverse_unify(Unification, CurId, !ConjMaps, !PredMap, !RelevantVars) :- ; ConsId = cons(SymName, Arity), Arity = 1, - StringModule = mercury_std_lib_module_name("string"), + StringModule = + mercury_std_lib_module_name(unqualified("string")), SymName = qualified(StringModule, Functor), ( Functor = "f", diff --git a/compiler/mlds.m b/compiler/mlds.m index 56b17e535..0354dad87 100644 --- a/compiler/mlds.m +++ b/compiler/mlds.m @@ -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_and_package_name_to_mlds(MLDS_Package, MercuryModule) 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. diff --git a/compiler/mlds_to_c.m b/compiler/mlds_to_c.m index c8fefafe4..acdc71532 100644 --- a/compiler/mlds_to_c.m +++ b/compiler/mlds_to_c.m @@ -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 @@ mlds_output_src_import(_Indent, Import, !IO) :- % 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 @@ mlds_output_c_hdr_decls(ModuleName, Indent, ForeignCode, !IO) :- 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) ), diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m index 96f2ff375..70c34fd41 100644 --- a/compiler/mlds_to_java.m +++ b/compiler/mlds_to_java.m @@ -161,8 +161,7 @@ output_mlds(ModuleInfo, MLDS, !IO) :- 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) ). diff --git a/compiler/mlds_to_managed.m b/compiler/mlds_to_managed.m index 41b0c2407..7236868c1 100644 --- a/compiler/mlds_to_managed.m +++ b/compiler/mlds_to_managed.m @@ -204,8 +204,8 @@ output_language_specific_header_code(lang_managed_cplusplus, ModuleName, (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" ) diff --git a/compiler/modules.m b/compiler/modules.m index 917879e4b..fc7160910 100644 --- a/compiler/modules.m +++ b/compiler/modules.m @@ -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 @@ write_foreign_dependency_for_il(DepStream, ModuleName, AllDeps, 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 @@ referenced_dlls(Module, DepModules0) = Modules :- % 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 @@ referenced_dlls(Module, DepModules0) = Modules :- ; F = (func(M) = ( - M = unqualified(S), - mercury_std_library_module(S) + mercury_std_library_module_name(M) -> unqualified("mercury") ; @@ -6001,7 +6003,7 @@ referenced_dlls(Module, DepModules0) = Modules :- 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), diff --git a/compiler/polymorphism.m b/compiler/polymorphism.m index 38a0239eb..96acd9b9e 100644 --- a/compiler/polymorphism.m +++ b/compiler/polymorphism.m @@ -402,6 +402,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. @@ -2931,8 +2932,9 @@ record_constraint_type_info_locns(Constraint, ExtraHeadVar, !Info) :- % 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 @@ -2940,15 +2942,17 @@ record_constraint_type_info_locns(Constraint, ExtraHeadVar, !Info) :- % 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 diff --git a/compiler/prog_type.m b/compiler/prog_type.m index 2df61b9d0..cf60c1253 100644 --- a/compiler/prog_type.m +++ b/compiler/prog_type.m @@ -756,7 +756,7 @@ constructor_list_represents_dummy_argument_type([Ctor], no) :- type_is_io_state(Type) :- type_to_ctor_and_args(Type, TypeCtor, []), - ModuleName = mercury_std_lib_module_name("io"), + ModuleName = mercury_std_lib_module_name(unqualified("io")), TypeCtor = type_ctor(qualified(ModuleName, "state"), 0). type_ctor_is_array(type_ctor(qualified(unqualified("array"), "array"), 1)). @@ -862,7 +862,7 @@ type_ctor_info_type = defined_type(Name, [], kind_star) :- Name = qualified(BuiltinModule, "type_ctor_info"). io_state_type = defined_type(Name, [], kind_star) :- - Module = mercury_std_lib_module_name("io"), + Module = mercury_std_lib_module_name(unqualified("io")), Name = qualified(Module, "state"). %-----------------------------------------------------------------------------% diff --git a/compiler/prog_util.m b/compiler/prog_util.m index eec8f7947..0a05b56d2 100644 --- a/compiler/prog_util.m +++ b/compiler/prog_util.m @@ -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 @@ construct_qualified_term(SymName, Args, Term) :- 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). diff --git a/compiler/simplify.m b/compiler/simplify.m index 2e5de5653..42776a0dd 100644 --- a/compiler/simplify.m +++ b/compiler/simplify.m @@ -1928,7 +1928,7 @@ simplify_library_call("int", PredName, _ModeNum, CrossCompiling, Args, detism_det, purity_pure, ConstGoalInfo), ConstGoal = ConstGoalExpr - ConstGoalInfo, - IntModuleSymName = mercury_std_lib_module_name("int"), + IntModuleSymName = mercury_std_lib_module_name(unqualified("int")), OpSymName = qualified(IntModuleSymName, Op), simplify_info_get_module_info(!.Info, ModuleInfo), module_info_get_predicate_table(ModuleInfo, PredTable), diff --git a/library/io.m b/library/io.m index 2929eef02..52137b674 100644 --- a/library/io.m +++ b/library/io.m @@ -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 @@ io.write_many(Stream, [f(F) | Rest], !IO) :- "ML_io_print_to_cur_stream"). io.print(Term, !IO) :- - io.do_print(canonicalize, Term, !IO). + io.output_stream(Stream, !IO), + stream.string_writer.print(Stream, 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(Stream, Term, !IO) :- + stream.string_writer.print(Stream, canonicalize, Term, !IO). -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.print_2(Stream, Term, !IO) :- - io.print(output_stream(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(output_stream(Stream), NonCanon, Term, !IO) :- - io.print_2(Stream, NonCanon, 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). +io.print(Stream, NonCanon, Term, !IO) :- + stream.string_writer.print(Stream, NonCanon, Term, !IO). io.print_cc(Term, !IO) :- - io.do_print(include_details_cc, Term, !IO). + io.output_stream(Stream, !IO), + stream.string_writer.print_cc(Stream, Term, !IO). -:- 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. +:- pred io.print_to_stream(io.stream::in, T::in, io::di, io::uo) is det. -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) - ). +:- pragma foreign_export("C", io.print_to_stream(in, in, di, uo), + "ML_io_print_to_stream"). -:- 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.print_quoted(NonCanon, Term, !IO) :- % 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 @@ io.result_to_stream_result(error(Error)) = error(Error). :- 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 diff --git a/library/library.m b/library/library.m index 6b8f9be49..a84b400ab 100644 --- a/library/library.m +++ b/library/library.m @@ -256,6 +256,7 @@ mercury_std_library_module("stack"). 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"). diff --git a/library/ops.m b/library/ops.m index ea0d30329..4bccf7a92 100644 --- a/library/ops.m +++ b/library/ops.m @@ -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 @@ ops.lookup_mercury_op_infos(_OpTable, Name, Info, OtherInfos) :- % 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 @@ ops.op_table(Op, Info, OtherInfos) :- ). %-----------------------------------------------------------------------------% + +:- pragma inline(adjust_priority_for_assoc/3). + +adjust_priority_for_assoc(Priority, y, Priority). +adjust_priority_for_assoc(Priority, x, Priority - 1). + +%-----------------------------------------------------------------------------% diff --git a/library/stream.m b/library/stream.m index f65ebbec4..a91cbcd00 100644 --- a/library/stream.m +++ b/library/stream.m @@ -24,6 +24,8 @@ :- import_module list. :- import_module string. +:- include_module string_writer. + %-----------------------------------------------------------------------------% % % Types used by streams @@ -278,20 +280,33 @@ %-----------------------------------------------------------------------------% % -% 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, State::di, State::uo) 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. + %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -371,12 +386,6 @@ stream.input_stream_fold2_state_maybe_stop(Stream, Pred, T0, Res, !S) :- ). %-----------------------------------------------------------------------------% - -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 @@ stream.ignore_whitespace(Stream, Result, !State) :- 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. %-----------------------------------------------------------------------------% diff --git a/library/stream.string_writer.m b/library/stream.string_writer.m new file mode 100644 index 000000000..1898ebd4d --- /dev/null +++ b/library/stream.string_writer.m @@ -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). + +%-----------------------------------------------------------------------------% diff --git a/library/term_io.m b/library/term_io.m index e1af122d2..901863ba4 100644 --- a/library/term_io.m +++ b/library/term_io.m @@ -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 @@ term_io.write_term_3(Ops, term.functor(Functor, Args, _), Priority, 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 @@ term_io.write_term_3(Ops, term.functor(Functor, Args, _), Priority, ), 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 @@ term_io.write_term_3(Ops, term.functor(Functor, Args, _), Priority, 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.format_constant_agt(term.string(S), _) = 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 @@ should_atom_be_quoted(S, NextToGraphicToken) = ShouldQuote :- % 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 @@ term_io.add_escaped_char(Char, String0) = String :- % 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 :- diff --git a/mdbcomp/prim_data.m b/mdbcomp/prim_data.m index c1c94f598..32f42ff55 100644 --- a/mdbcomp/prim_data.m +++ b/mdbcomp/prim_data.m @@ -212,7 +212,7 @@ % Returns the sym_name of the module with the given name in the % Mercury standard library. % -:- func mercury_std_lib_module_name(string) = sym_name. +:- func mercury_std_lib_module_name(sym_name) = sym_name. :- pred is_std_lib_module_name(sym_name::in, string::out) is semidet. @@ -297,10 +297,10 @@ mercury_table_builtin_module = unqualified("table_builtin"). mercury_profiling_builtin_module = unqualified("profiling_builtin"). mercury_term_size_prof_builtin_module = unqualified("term_size_prof_builtin"). mercury_par_builtin_module = unqualified("par_builtin"). -mercury_std_lib_module_name(Name) = unqualified(Name). +mercury_std_lib_module_name(Name) = Name. is_std_lib_module_name(SymName, Name) :- - SymName = unqualified(Name), + Name = sym_name_to_string(SymName), mercury_std_library_module(Name). any_mercury_builtin_module(Module) :- diff --git a/tests/hard_coded/stream_format.m b/tests/hard_coded/stream_format.m index d31ea2e6b..b83ace403 100644 --- a/tests/hard_coded/stream_format.m +++ b/tests/hard_coded/stream_format.m @@ -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). diff --git a/tests/hard_coded/test_injection.m b/tests/hard_coded/test_injection.m index 45078c3b5..92b72ab03 100644 --- a/tests/hard_coded/test_injection.m +++ b/tests/hard_coded/test_injection.m @@ -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 @@ test(Pred, Name, !IO) :- ; 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) ). diff --git a/tests/invalid/string_format_bad.m b/tests/invalid/string_format_bad.m index 7bed3f3b7..4f4d58e2b 100644 --- a/tests/invalid/string_format_bad.m +++ b/tests/invalid/string_format_bad.m @@ -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 @@ main(!IO) :- 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", diff --git a/tests/invalid/string_format_unknown.m b/tests/invalid/string_format_unknown.m index 088be6cb0..72b428180 100644 --- a/tests/invalid/string_format_unknown.m +++ b/tests/invalid/string_format_unknown.m @@ -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 @@ main(!IO) :- 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", ( diff --git a/util/mdemangle.c b/util/mdemangle.c index 558cedf6a..b0daa8fc3 100644 --- a/util/mdemangle.c +++ b/util/mdemangle.c @@ -1,7 +1,7 @@ /*---------------------------------------------------------------------------*/ /* -** Copyright (C) 1995-2005 The University of Melbourne. +** Copyright (C) 1995-2006 The University of Melbourne. ** This file may only be copied under the terms of the GNU General ** Public License - see the file COPYING in the Mercury distribution. */ @@ -262,7 +262,7 @@ demangle(const char *orig_name) ** 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 @@ typeclass_info: 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() */