%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2006-2007, 2011 The University of Melbourne. % Copyright (C) 2014-2026 The Mercury team. % This file is distributed under the terms specified in COPYING.LIB. %---------------------------------------------------------------------------% % % File: stream.string_writer.m. % Authors: trd, fjh, stayl. % Stability: high. % % Predicates to write to streams that accept strings. % %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- module stream.string_writer. :- interface. :- import_module char. :- import_module deconstruct. :- import_module io. :- import_module list. :- import_module string. :- import_module string.builder. :- import_module univ. %---------------------------------------------------------------------------% :- pred put_int(Stream::in, int::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). :- pred put_int8(Stream::in, int8::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). :- pred put_int16(Stream::in, int16::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). :- pred put_int32(Stream::in, int32::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). :- pred put_int64(Stream::in, int64::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). :- pred put_uint(Stream::in, uint::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). :- pred put_uint8(Stream::in, uint8::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). :- pred put_uint16(Stream::in, uint16::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). :- pred put_uint32(Stream::in, uint32::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). :- pred put_uint64(Stream::in, uint64::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(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/4 writes its second argument to the string writer 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 integer (i.e. % an arbitrary precision integer), then its decimal representation will be % printed. If the argument is of type univ, then the value stored in the % univ will be printed out, but not the type. If the argument is of % type date_time, it will be printed out in the same form as the string % returned by the function date_to_string/1. If the argument is of type % duration, it will be printed out in the same form as the string % returned by the function duration_to_string/1. % % print/5 is the same as print/4 except that it allows the caller to % specify how non-canonical types should be handled. print/4 implicitly % specifies `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/4 is the same as print/4 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). :- pred print_cc(Stream::in, T::in, State::di, State::uo) is cc_multi <= stream.writer(Stream, string, State). :- pred print(Stream, deconstruct.noncanon_handling, T, State, State) <= stream.writer(Stream, string, 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. % write/4 writes its second argument to the string writer 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 and backslash or octal escapes for all characters % for which char.is_control/1 is true. For higher-order types, or for types % defined using the foreign language interface (pragma foreign_type), 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). :- pred write_cc(Stream::in, T::in, State::di, State::uo) is cc_multi <= stream.writer(Stream, string, State). :- pred write(Stream, deconstruct.noncanon_handling, T, State, State) <= stream.writer(Stream, string, 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. %---------------------------------------------------------------------------% :- pragma type_spec_constrained_preds( [stream.writer(Stream, string, State)], apply_to_superclasses, [subst([Stream => io.text_output_stream, State = io.state]), subst([Stream => string.builder.handle, State = string.builder.state])]). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- interface. :- import_module ops. % % 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). :- pred write_univ(Stream, deconstruct.noncanon_handling, univ, State, State) <= stream.writer(Stream, string, 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. % % For use by term_io.m. % :- pred maybe_write_paren(Stream::in, string::in, ops.priority::in, ops.priority::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). %---------------------------------------------------------------------------% :- implementation. :- import_module array. :- import_module bitmap. :- import_module calendar. :- import_module int. :- import_module integer. :- import_module io.stream_db. :- import_module require. :- import_module rtti_implementation. :- import_module term_io. :- import_module type_desc. :- import_module version_array. %---------------------------------------------------------------------------% put_int(Stream, Int, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_int(IOStream, Int, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.int_to_string(Int), !State) ). put_int8(Stream, Int8, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_int8(IOStream, Int8, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.int8_to_string(Int8), !State) ). put_int16(Stream, Int16, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_int16(IOStream, Int16, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.int16_to_string(Int16), !State) ). put_int32(Stream, Int32, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_int32(IOStream, Int32, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.int32_to_string(Int32), !State) ). put_int64(Stream, Int64, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_int64(IOStream, Int64, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.int64_to_string(Int64), !State) ). %---------------------------------------------------------------------------% put_uint(Stream, UInt, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_uint(IOStream, UInt, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.uint_to_string(UInt), !State) ). put_uint8(Stream, UInt8, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_uint8(IOStream, UInt8, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.uint8_to_string(UInt8), !State) ). put_uint16(Stream, UInt16, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_uint16(IOStream, UInt16, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.uint16_to_string(UInt16), !State) ). put_uint32(Stream, UInt32, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_uint32(IOStream, UInt32, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.uint32_to_string(UInt32), !State) ). put_uint64(Stream, UInt64, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_uint64(IOStream, UInt64, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.uint64_to_string(UInt64), !State) ). %---------------------------------------------------------------------------% put_float(Stream, Float, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_float(IOStream, Float, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.float_to_string(Float), !State) ). put_char(Stream, Char, !State) :- ( if % Handle the common I/O case more efficiently. dynamic_cast(!.State, IOState0), dynamic_cast(Stream, IOStream) then io.write_char(IOStream, Char, unsafe_promise_unique(IOState0), IOState), ( if dynamic_cast(IOState, !:State) then !:State = unsafe_promise_unique(!.State) else error($pred, "unexpected type error") ) else put(Stream, string.char_to_string(Char), !State) ). %---------------------------------------------------------------------------% format(Stream, FormatString, Arguments, !State) :- disable_warning [unknown_format_calls] ( string.format(FormatString, Arguments, String) ), put(Stream, String, !State). nl(Stream, !State) :- put(Stream, "\n", !State). %---------------------------------------------------------------------------% % % Various different versions of print. % % The builtin types within the builtin.m module whose printing % we may want to specialize. % :- type builtin_type_in_builtin ---> type_builtin_string ; type_builtin_character ; type_builtin_float ; type_builtin_int ; type_builtin_int8 ; type_builtin_int16 ; type_builtin_int32 ; type_builtin_int64 ; type_builtin_uint ; type_builtin_uint8 ; type_builtin_uint16 ; type_builtin_uint32 ; type_builtin_uint64 ; type_builtin_c_ptr. 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) :- % In the general case, we call print_quoted below, which is itself % intended to call write in most cases. (For now, it calls write % in all cases). The purpose of this predicate is to special-case % the handling several types, which we do for either of two purposes. % % The purpose that applies to most of the types handled below % is to print things in a more user-friendly fashion than write can. % The write predicate is required to output terms in a form that is % round-trippable, which means when the string that we write out % is read back in, the result should be *exactly* the term we wrote out. % For all the integral types except int itself, this means write % has to append a suffix (u, i8, u8 etc), which print does not append. % For strings and characters, write adds quotes, while print does not. % And so on. % % The other purpose is speed. We expect that handling ints and floats % should be a bit faster with the special case code than the general code. % Since they occur often enough in many workloads, optimizing them % is a good idea. TypeDesc = type_of(Term), TypeCtorDesc = type_ctor(TypeDesc), type_ctor_name_and_arity(TypeCtorDesc, TypeCtorModuleName, TypeCtorName, _TypeCtorArity), ( if ( TypeCtorModuleName = "builtin" ; TypeCtorModuleName = "integer" ; TypeCtorModuleName = "univ" ; TypeCtorModuleName = "calendar" ) then % The code for each type we handle here calls the code for % the generic case if the dynamic cast to the expected type fails. % The reason why we do that is that we want to do the right thing % in two very unlikely but possible cases: that we add new type % constructors to these modules with the same names but different % arities, and that the user links into their programs their own % modules with the same names but different contents as the % standard library modules. The latter can't happen with builtin.m % and private_builtin.m, since those are always implicitly imported % into every module, but can happen with the others. ( TypeCtorModuleName = "builtin", ( if ( TypeCtorName = "string", TB = type_builtin_string ; TypeCtorName = "character", TB = type_builtin_character ; TypeCtorName = "float", TB = type_builtin_float ; TypeCtorName = "int", TB = type_builtin_int ; TypeCtorName = "int8", TB = type_builtin_int8 ; TypeCtorName = "int16", TB = type_builtin_int16 ; TypeCtorName = "int32", TB = type_builtin_int32 ; TypeCtorName = "int64", TB = type_builtin_int64 ; TypeCtorName = "uint", TB = type_builtin_uint ; TypeCtorName = "uint8", TB = type_builtin_uint8 ; TypeCtorName = "uint16", TB = type_builtin_uint16 ; TypeCtorName = "uint32", TB = type_builtin_uint32 ; TypeCtorName = "uint64", TB = type_builtin_uint64 ) then ( TB = type_builtin_string, ( if dynamic_cast(Term, String : string) then put(Stream, String, !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_character, ( if dynamic_cast(Term, Char : char) then put(Stream, char_to_string(Char), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_float, ( if dynamic_cast(Term, Float : float) then put(Stream, string.float_to_string(Float), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_int, ( if dynamic_cast(Term, Int : int) then put(Stream, int_to_string(Int), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_int8, ( if dynamic_cast(Term, Int8 : int8) then put(Stream, int8_to_string(Int8), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_int16, ( if dynamic_cast(Term, Int16 : int16) then put(Stream, int16_to_string(Int16), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_int32, ( if dynamic_cast(Term, Int32 : int32) then put(Stream, int32_to_string(Int32), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_int64, ( if dynamic_cast(Term, Int64 : int64) then put(Stream, int64_to_string(Int64), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_uint, ( if dynamic_cast(Term, UInt : uint) then put(Stream, uint_to_string(UInt), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_uint8, ( if dynamic_cast(Term, UInt8 : uint8) then put(Stream, uint8_to_string(UInt8), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_uint16, ( if dynamic_cast(Term, UInt16 : uint16) then put(Stream, uint16_to_string(UInt16), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_uint32, ( if dynamic_cast(Term, UInt32 : uint32) then put(Stream, uint32_to_string(UInt32), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TB = type_builtin_uint64, ( if dynamic_cast(Term, UInt64 : uint64) then put(Stream, uint64_to_string(UInt64), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ) else print_quoted(Stream, NonCanon, Term, !State) ) ; TypeCtorModuleName = "integer", ( if dynamic_cast(Term, BigInt) then put(Stream, integer.to_string(BigInt), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TypeCtorModuleName = "univ", ( if dynamic_cast(Term, OrigUniv) then write_univ(Stream, OrigUniv, !State) else print_quoted(Stream, NonCanon, Term, !State) ) ; TypeCtorModuleName = "calendar", ( if dynamic_cast(Term, DateTime) then put(Stream, date_time_to_string(DateTime), !State) else if dynamic_cast(Term, Duration) then put(Stream, duration_to_string(Duration), !State) else print_quoted(Stream, NonCanon, Term, !State) ) ) else print_quoted(Stream, NonCanon, Term, !State) ). :- pred print_quoted(Stream, deconstruct.noncanon_handling, T, State, State) <= stream.writer(Stream, string, 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 class membership tests, then instead % of write(Term), we will want to do something like % ( if univ_to_type_class(Univ, Portrayable) then % portray(Stream, Portrayable, !State) % else % ... 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). :- 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. do_write_univ(Stream, NonCanon, Univ, !State) :- do_write_univ_prio(Stream, NonCanon, Univ, ops.mercury_op_table_universal_priority, !State). :- pred do_write_univ_prio(Stream, deconstruct.noncanon_handling, univ, ops.priority, State, State) <= stream.writer(Stream, string, 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. % We only use the io.stream_db we read impurely when we have the io.state. :- pragma promise_pure(pred(do_write_univ_prio/6)). do_write_univ_prio(Stream, NonCanon, Univ, Priority, !State) :- % We need to special-case a whole bunch of builtin types. TypeDesc = univ_type(Univ), type_ctor_and_args(TypeDesc, TypeCtorDesc, ArgTypeDescs), type_ctor_name_and_arity(TypeCtorDesc, TypeCtorModuleName, TypeCtorName, _TypeCtorArity), ( if ( TypeCtorModuleName = "builtin" ; TypeCtorModuleName = "private_builtin" ; TypeCtorModuleName = "bitmap" ; TypeCtorModuleName = "type_desc" ; TypeCtorModuleName = "io" ; TypeCtorModuleName = "array" ; TypeCtorModuleName = "version_array" ) then % The code for each type we handle here calls the code for % the generic case if the dynamic cast to the expected type fails. % The comment in print above explains why we do this. ( TypeCtorModuleName = "builtin", ( if ( TypeCtorName = "string", TB = type_builtin_string ; TypeCtorName = "character", TB = type_builtin_character ; TypeCtorName = "float", TB = type_builtin_float ; TypeCtorName = "int", TB = type_builtin_int ; TypeCtorName = "int8", TB = type_builtin_int8 ; TypeCtorName = "int16", TB = type_builtin_int16 ; TypeCtorName = "int32", TB = type_builtin_int32 ; TypeCtorName = "int64", TB = type_builtin_int64 ; TypeCtorName = "uint", TB = type_builtin_uint ; TypeCtorName = "uint8", TB = type_builtin_uint8 ; TypeCtorName = "uint16", TB = type_builtin_uint16 ; TypeCtorName = "uint32", TB = type_builtin_uint32 ; TypeCtorName = "uint64", TB = type_builtin_uint64 ; TypeCtorName = "c_pointer", TB = type_builtin_c_ptr ) then ( TB = type_builtin_string, ( if univ_to_type(Univ, String) then term_io.format_quoted_string(Stream, String, !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_character, ( if univ_to_type(Univ, Char) then term_io.format_quoted_char(Stream, Char, !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_float, ( if univ_to_type(Univ, Float) then put_float(Stream, Float, !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_int, ( if univ_to_type(Univ, Int) then put_int(Stream, Int, !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_int8, ( if univ_to_type(Univ, Int8) then put_int8(Stream, Int8, !State), put(Stream, "i8", !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_int16, ( if univ_to_type(Univ, Int16) then put_int16(Stream, Int16, !State), put(Stream, "i16", !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_int32, ( if univ_to_type(Univ, Int32) then put_int32(Stream, Int32, !State), put(Stream, "i32", !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_int64, ( if univ_to_type(Univ, Int64) then put_int64(Stream, Int64, !State), put(Stream, "i64", !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_uint, ( if univ_to_type(Univ, UInt) then put_uint(Stream, UInt, !State), put(Stream, "u", !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_uint8, ( if univ_to_type(Univ, UInt8) then put_uint8(Stream, UInt8, !State), put(Stream, "u8", !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_uint16, ( if univ_to_type(Univ, UInt16) then put_uint16(Stream, UInt16, !State), put(Stream, "u16", !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_uint32, ( if univ_to_type(Univ, UInt32) then put_uint32(Stream, UInt32, !State), put(Stream, "u32", !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_uint64, ( if univ_to_type(Univ, UInt64) then put_uint64(Stream, UInt64, !State), put(Stream, "u64", !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TB = type_builtin_c_ptr, ( if univ_to_type(Univ, C_Pointer) then write_c_pointer(Stream, C_Pointer, !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TypeCtorModuleName = "bitmap", ( if univ_to_type(Univ, Bitmap) then % Bitmaps are converted to strings of hex digits. put(Stream, "\"", !State), put(Stream, bitmap.to_string(Bitmap), !State), put(Stream, "\"", !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TypeCtorModuleName = "type_desc", ( if univ_to_type(Univ, UnivTypeDesc) then write_type_desc(Stream, UnivTypeDesc, !State) else if univ_to_type(Univ, UnivTypeCtorDesc) then write_type_ctor_desc(Stream, UnivTypeCtorDesc, !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TypeCtorModuleName = "io", ( if impure get_stream_db_with_locking(StreamDB), get_io_stream_info(StreamDB, univ_value(Univ), StreamInfo) then type_to_univ(StreamInfo, StreamInfoUniv), do_write_univ_prio(Stream, NonCanon, StreamInfoUniv, Priority, !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TypeCtorModuleName = "array", ( if % 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. TypeCtorName = "array", ArgTypeDescs = [ElemType] then % 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) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TypeCtorModuleName = "version_array", ( if TypeCtorName = "version_array", ArgTypeDescs = [ElemType] then has_type(Elem, ElemType), same_version_array_elem_type(VersionArray, Elem), det_univ_to_type(Univ, VersionArray), write_version_array(Stream, VersionArray, !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ; TypeCtorModuleName = "private_builtin", ( if % Check if the type is private_builtin.type_info/1. % See the comments above for array.array/1. TypeCtorName = "type_info", ArgTypeDescs = [ElemType] then has_type(Elem, ElemType), same_private_builtin_type(PrivateBuiltinTypeInfo, Elem), det_univ_to_type(Univ, PrivateBuiltinTypeInfo), write_private_builtin_type_info(Stream, PrivateBuiltinTypeInfo, !State) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ) ) else write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) ). :- pred same_array_elem_type(array(T)::unused, T::unused) is det. same_array_elem_type(_, _). :- pred same_version_array_elem_type(version_array(T)::unused, T::unused) is det. same_version_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). :- 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. write_ordinary_term(Stream, NonCanon, Univ, Priority, !State) :- % NOTE: The code of this predicate should be kept in sync with % the code of ordinary_term_to_revstrings in string.to_string.m. % XXX The code for handling tuples is currently NOT in sync. univ_value(Univ) = Term, deconstruct.deconstruct(Term, NonCanon, Functor, _Arity, Args), ( if Functor = "[|]", Args = [ListHead, ListTail] then put(Stream, "[", !State), write_arg(Stream, NonCanon, ListHead, !State), write_list_tail(Stream, NonCanon, ListTail, !State), put(Stream, "]", !State) else if Functor = "[]", Args = [] then put(Stream, "[]", !State) else if Functor = "{}", Args = [BracedHead | BracedTail] then ( BracedTail = [], put(Stream, "{ ", !State), do_write_univ(Stream, NonCanon, BracedHead, !State), put(Stream, " }", !State) ; BracedTail = [_ | _], % If we add padding after { and before } for tuples % containing one term, why do we not also do so for tuples % containing more than one term? % % (compiler/parse_tree_out_term.m says it is because non-DCG % goals in DCG clauses look like one-argument tuples, and % by tradition, they have spaces between the goal and % the { and }.) However, that is not an argument for % doing this for *all* uses of {}. put(Stream, "{", !State), write_arg(Stream, NonCanon, BracedHead, !State), write_term_args(Stream, NonCanon, BracedTail, !State), put(Stream, "}", !State) ) else if ops.lookup_op_infos(ops.init_mercury_op_table, Functor, OpInfos) then ( ( Args = [] ; Args = [_, _, _ | _] ), write_functor_and_args_prio(Stream, NonCanon, Priority, Functor, Args, !State) ; Args = [ArgA], ( if OpInfos ^ oi_prefix = pre(OpPriority, GtOrGeA) then maybe_write_paren(Stream, "(", Priority, OpPriority, !State), term_io.format_quoted_atom(Stream, Functor, !State), put(Stream, " ", !State), MinPrioA = min_priority_for_arg(OpPriority, GtOrGeA), do_write_univ_prio(Stream, NonCanon, ArgA, MinPrioA, !State), maybe_write_paren(Stream, ")", Priority, OpPriority, !State) else if OpInfos ^ oi_postfix = post(OpPriority, GtOrGeA) then maybe_write_paren(Stream, "(", Priority, OpPriority, !State), MinPrioA = min_priority_for_arg(OpPriority, GtOrGeA), do_write_univ_prio(Stream, NonCanon, ArgA, MinPrioA, !State), put(Stream, " ", !State), term_io.format_quoted_atom(Stream, Functor, !State), maybe_write_paren(Stream, ")", Priority, OpPriority, !State) else write_functor_and_args_prio(Stream, NonCanon, Priority, Functor, Args, !State) ) ; Args = [ArgA, ArgB], ( if OpInfos ^ oi_infix = in(OpPriority, GtOrGeA, GtOrGeB) then MinPrioA = min_priority_for_arg(OpPriority, GtOrGeA), MinPrioB = min_priority_for_arg(OpPriority, GtOrGeB), maybe_write_paren(Stream, "(", Priority, OpPriority, !State), do_write_univ_prio(Stream, NonCanon, ArgA, MinPrioA, !State), ( if Functor = "," then put(Stream, ", ", !State) else put(Stream, " ", !State), term_io.format_quoted_atom(Stream, Functor, !State), put(Stream, " ", !State) ), do_write_univ_prio(Stream, NonCanon, ArgB, MinPrioB, !State), maybe_write_paren(Stream, ")", Priority, OpPriority, !State) else if OpInfos ^ oi_binary_prefix = bin_pre(OpPriority, GtOrGeA, GtOrGeB) then MinPrioA = min_priority_for_arg(OpPriority, GtOrGeA), MinPrioB = min_priority_for_arg(OpPriority, GtOrGeB), maybe_write_paren(Stream, "(", Priority, OpPriority, !State), term_io.format_quoted_atom(Stream, Functor, !State), put(Stream, " ", !State), do_write_univ_prio(Stream, NonCanon, ArgA, MinPrioA, !State), put(Stream, " ", !State), do_write_univ_prio(Stream, NonCanon, ArgB, MinPrioB, !State), maybe_write_paren(Stream, ")", Priority, OpPriority, !State) else write_functor_and_args_prio(Stream, NonCanon, Priority, Functor, Args, !State) ) ) else write_functor_and_args(Stream, NonCanon, Functor, Args, !State) ). % write_functor_and_args_prio(Stream, NonCanon, Priority, Functor, Args, % !State): % % Write out the term represented by Functor(Args) when % % - Functor is an operator, but % - it is not applied to the number of arguments it expects. % :- pred write_functor_and_args_prio(Stream, deconstruct.noncanon_handling, priority, string, list(univ), State, State) <= stream.writer(Stream, string, State). :- mode write_functor_and_args_prio(in, in(do_not_allow), in, in, in, di, uo) is det. :- mode write_functor_and_args_prio(in, in(canonicalize), in, in, in, di, uo) is det. :- mode write_functor_and_args_prio(in, in(include_details_cc), in, in, in, di, uo) is cc_multi. :- mode write_functor_and_args_prio(in, in, in, in, in, di, uo) is cc_multi. :- pragma inline(pred(write_functor_and_args_prio/7)). write_functor_and_args_prio(Stream, NonCanon, Priority, Functor, Args, !State) :- ( if Args = [], priority_ge(Priority, ops.mercury_op_table_loosest_op_priority) then put(Stream, "(", !State), term_io.format_quoted_atom(Stream, Functor, !State), put(Stream, ")", !State) else write_functor_and_args(Stream, NonCanon, Functor, Args, !State) ). % write_functor_and_args(Stream, NonCanon, Functor, Args, !State): % % Write out the term represented by Functor(Args). % :- pred write_functor_and_args(Stream, deconstruct.noncanon_handling, string, list(univ), State, State) <= stream.writer(Stream, string, 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 inline(pred(write_functor_and_args/6)). write_functor_and_args(Stream, NonCanon, Functor, Args, !State) :- AGT = maybe_adjacent_to_graphic_token, term_io.format_quoted_atom_agt(Stream, Functor, AGT, !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(pred(maybe_write_paren/6)). maybe_write_paren(Stream, String, Priority, OpPriority, !State) :- ( if priority_lt(OpPriority, Priority) then put(Stream, String, !State) else true ). :- pred write_list_tail(Stream, deconstruct.noncanon_handling, univ, State, State) <= stream.writer(Stream, string, 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. write_list_tail(Stream, NonCanon, Univ, !State) :- Term = univ_value(Univ), deconstruct.deconstruct(Term, NonCanon, Functor, _Arity, Args), ( if Functor = "[|]", Args = [ListHead, ListTail] then put(Stream, ", ", !State), write_arg(Stream, NonCanon, ListHead, !State), write_list_tail(Stream, NonCanon, ListTail, !State) else if Functor = "[]", Args = [] then true else 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). :- 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. 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). :- 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. write_arg(Stream, NonCanon, X, !State) :- CommaPrio = mercury_op_table_comma_priority, do_write_univ_prio(Stream, NonCanon, X, CommaPrio, !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), ( if ModuleName = "builtin", Name = "func" then % The type ctor that we call `builtin:func/N' takes N + 1 % type parameters: N arguments, and one return value. % So we need to subtract one from the arity here. Arity = Arity0 - 1 else Arity = Arity0 ), ( if ModuleName = "builtin" then format(Stream, "%s/%d", [s(Name), i(Arity)], !State) else 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). write_array(Stream, Array, !State) :- put(Stream, "array(", !State), array.to_list(Array, List), write(Stream, List, !State), put(Stream, ")", !State). :- pred write_version_array(Stream::in, version_array(T)::in, State::di, State::uo) is det <= stream.writer(Stream, string, State). write_version_array(Stream, VersionArray, !State) :- put(Stream, "version_array(", !State), List = version_array.to_list(VersionArray), 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) :- private_builtin.unsafe_type_cast(PrivateBuiltinTypeInfo, TypeInfo), type_info_to_type_desc(TypeInfo, TypeDesc), write_type_desc(Stream, TypeDesc, !State). %---------------------------------------------------------------------------% :- end_module stream.string_writer. %---------------------------------------------------------------------------%