mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 17:33:38 +00:00
Code Issues Projects Releases Wiki Activity
Files
52317df5bb73d43fbcb2df199767cbeea24535aa
mercury/library/string.format.m
Zoltan Somogyi 3f72528869 Update module stability levels.
2025-08-11 22:32:52 +02:00

2142 lines
76 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
% Copyright (C) 2014-2015, 2017-2023, 2025 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: string.format.m.
% Stability: high.
%
% This module implements string.format.
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module string.format.
:- interface.
:- import_module list.
:- import_module string.parse_util.
%---------------------------------------------------------------------------%
% The implementation of string.format. This is exported for use
% by string.m.
%
:- pred format_impl(string::in, list(poly_type)::in, string::out) is det.
% Functions to print characters, strings, signed and unsigned ints,
% and floats. These versions of these functions are not called
% by the runtime, but they have calls generated to them by
% compiler/format_call.m. By having specialized versions for each
% possible combination of which of parameters (width and precision)
% are specified, we can avoid requiring the compiler to generate code
% that allocates memory on the heap.
%
% NOTE: if you add new predicates here then you must also update the
% predicate simplify_may_introduce_calls/3 in compiler/simplify_proc.m.
%
:- pred format_char_component_nowidth(string_format_flags::in,
char::in, string::out) is det.
:- pred format_char_component_width(string_format_flags::in,
int::in, char::in, string::out) is det.
:- pred format_string_component_nowidth_noprec(string_format_flags::in,
string::in, string::out) is det.
:- pred format_string_component_nowidth_prec(string_format_flags::in,
int::in, string::in, string::out) is det.
:- pred format_string_component_width_noprec(string_format_flags::in,
int::in, string::in, string::out) is det.
:- pred format_string_component_width_prec(string_format_flags::in,
int::in, int::in, string::in, string::out) is det.
:- pred format_signed_int_component_nowidth_noprec(string_format_flags::in,
int::in, string::out) is det.
:- pred format_signed_int_component_nowidth_prec(string_format_flags::in,
int::in, int::in, string::out) is det.
:- pred format_signed_int_component_width_noprec(string_format_flags::in,
int::in, int::in, string::out) is det.
:- pred format_signed_int_component_width_prec(string_format_flags::in,
int::in, int::in, int::in, string::out) is det.
:- pred format_uint_component_nowidth_noprec(string_format_flags::in,
string_format_int_base::in, uint::in, string::out) is det.
:- pred format_uint_component_nowidth_prec(string_format_flags::in,
int::in, string_format_int_base::in, uint::in, string::out) is det.
:- pred format_uint_component_width_noprec(string_format_flags::in,
int::in, string_format_int_base::in, uint::in, string::out) is det.
:- pred format_uint_component_width_prec(string_format_flags::in,
int::in, int::in, string_format_int_base::in, uint::in, string::out)
is det.
:- pred format_signed_int64_component_nowidth_noprec(string_format_flags::in,
int64::in, string::out) is det.
:- pred format_signed_int64_component_nowidth_prec(string_format_flags::in,
int::in, int64::in, string::out) is det.
:- pred format_signed_int64_component_width_noprec(string_format_flags::in,
int::in, int64::in, string::out) is det.
:- pred format_signed_int64_component_width_prec(string_format_flags::in,
int::in, int::in, int64::in, string::out) is det.
:- pred format_unsigned_int64_component_nowidth_noprec(string_format_flags::in,
string_format_int_base::in, int64::in, string::out) is det.
:- pred format_unsigned_int64_component_nowidth_prec(string_format_flags::in,
int::in, string_format_int_base::in, int64::in, string::out) is det.
:- pred format_unsigned_int64_component_width_noprec(string_format_flags::in,
int::in, string_format_int_base::in, int64::in, string::out) is det.
:- pred format_unsigned_int64_component_width_prec(string_format_flags::in,
int::in, int::in, string_format_int_base::in, int64::in, string::out)
is det.
:- pred format_uint64_component_nowidth_noprec(string_format_flags::in,
string_format_int_base::in, uint64::in, string::out) is det.
:- pred format_uint64_component_nowidth_prec(string_format_flags::in,
int::in, string_format_int_base::in, uint64::in, string::out) is det.
:- pred format_uint64_component_width_noprec(string_format_flags::in,
int::in, string_format_int_base::in, uint64::in, string::out) is det.
:- pred format_uint64_component_width_prec(string_format_flags::in,
int::in, int::in, string_format_int_base::in, uint64::in, string::out)
is det.
:- pred format_float_component_nowidth_noprec(string_format_flags::in,
string_format_float_kind::in, float::in, string::out) is det.
:- pred format_float_component_nowidth_prec(string_format_flags::in,
int::in, string_format_float_kind::in, float::in, string::out) is det.
:- pred format_float_component_width_noprec(string_format_flags::in,
int::in, string_format_float_kind::in, float::in, string::out) is det.
:- pred format_float_component_width_prec(string_format_flags::in,
int::in, int::in, string_format_float_kind::in, float::in, string::out)
is det.
:- pred format_cast_int8_to_int(int8::in, int::out) is det.
:- pred format_cast_int16_to_int(int16::in, int::out) is det.
:- pred format_cast_int32_to_int(int32::in, int::out) is det.
:- pred format_cast_int_to_uint(int::in, uint::out) is det.
:- pred format_cast_int8_to_uint(int8::in, uint::out) is det.
:- pred format_cast_int16_to_uint(int16::in, uint::out) is det.
:- pred format_cast_int32_to_uint(int32::in, uint::out) is det.
:- pred format_cast_uint8_to_uint(uint8::in, uint::out) is det.
:- pred format_cast_uint16_to_uint(uint16::in, uint::out) is det.
:- pred format_cast_uint32_to_uint(uint32::in, uint::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module bool.
:- import_module exception.
:- import_module float.
:- import_module int.
:- import_module integer.
:- import_module require.
:- import_module string.parse_runtime.
:- import_module uint.
:- use_module int8.
:- use_module int16.
:- use_module int32.
:- use_module int64.
:- use_module uint8.
:- use_module uint16.
:- use_module uint32.
:- use_module uint64.
%---------------------------------------------------------------------------%
:- pragma foreign_decl("C",
"
#include ""mercury_float.h"" // for MR_float_to_string
// The following macro should expand to MR_TRUE if the C grades should
// implement string.format using C's sprintf function.
// Setting it to MR_FALSE will cause string.format to use the Mercury
// implementation of string formatting in C grades.
#define ML_USE_SPRINTF MR_TRUE
").
%---------------------------------------------------------------------------%
string.format.format_impl(FormatString, PolyList, String) :-
% The call tree of this predicate should be optimised to turn over
% the least amount of memory possible, since memory usage is a significant
% problem for programs which do a lot of formatted IO.
%
% XXX The repeated string appends performed in the call tree
% do still allocate nontrivial amounts of memory for temporaries.
%
% XXX ILSEQ to_char_list cannot handle ill-formed sequences in the format
% string. Ideally they would be treated like constant strings.
Chars = to_char_list(FormatString),
parse_format_string(Chars, PolyList, 1, Specs, Errors),
(
Errors = [],
specs_to_strings(Specs, SpecStrs),
String = string.append_list(SpecStrs)
;
Errors = [HeadError | _],
% In the common cases of missing or extra PolyTypes, all the errors
% after the first may be avalanche errors, and would probably be more
% confusing than helpful. This is why we traditionally print a message
% only for the first one.
%
% XXX We should try printing messages for all the errors, not just
% the first, and see whether the usefulness of the extra information
% outweighs the costs of any extra confusion.
Msg = string_format_error_to_msg(HeadError),
error("string.format", Msg)
).
%---------------------------------------------------------------------------%
:- pred specs_to_strings(list(string_format_spec)::in,
list(string)::out) is det.
specs_to_strings([], []).
specs_to_strings([Spec | Specs], [String | Strings]) :-
spec_to_string(Spec, String),
specs_to_strings(Specs, Strings).
:- pred spec_to_string(string_format_spec::in, string::out) is det.
spec_to_string(Spec, String) :-
(
% Constant strings.
Spec = spec_constant_string(String)
;
% Signed int conversion specifiers.
Spec = spec_signed_int(Flags, MaybeWidth, MaybePrec, SizedInt),
( if SizedInt = sized_int64(Int64) then
format_signed_int64_component(Flags, MaybeWidth, MaybePrec, Int64,
String)
else
Int = sized_int_to_int(SizedInt),
format_signed_int_component(Flags, MaybeWidth, MaybePrec, Int,
String)
)
;
% Unsigned int conversion specifiers (for signed values).
Spec = spec_unsigned_int(Flags, MaybeWidth, MaybePrec, Base, SizedInt),
( if SizedInt = sized_int64(Int64) then
format_unsigned_int64_component(Flags, MaybeWidth, MaybePrec, Base,
Int64, String)
else
UInt = sized_int_to_uint(SizedInt),
format_uint_component(Flags, MaybeWidth, MaybePrec, Base, UInt,
String)
)
;
% Unsigned int conversion specifiers (for unsigned values).
Spec = spec_uint(Flags, MaybeWidth, MaybePrec, Base, SizedUInt),
( if SizedUInt = sized_uint64(UInt64) then
format_uint64_component(Flags, MaybeWidth, MaybePrec, Base, UInt64,
String)
else
UInt = sized_uint_to_uint(SizedUInt),
format_uint_component(Flags, MaybeWidth, MaybePrec, Base, UInt,
String)
)
;
% Float conversion specifiers.
Spec = spec_float(Flags, MaybeWidth, MaybePrec, Kind, Float),
format_float_component(Flags, MaybeWidth, MaybePrec, Kind, Float,
String)
;
% Char conversion specifiers.
Spec = spec_char(Flags, MaybeWidth, Char),
format_char_component(Flags, MaybeWidth, Char, String)
;
% String conversion specifiers.
Spec = spec_string(Flags, MaybeWidth, MaybePrec, Str),
format_string_component(Flags, MaybeWidth, MaybePrec, Str, String)
).
%---------------------------------------------------------------------------%
format_char_component_nowidth(Flags, Char, String) :-
MaybeWidth = no_specified_width,
format_char_component(Flags, MaybeWidth, Char, String).
format_char_component_width(Flags, Width, Char, String) :-
MaybeWidth = specified_width(Width),
format_char_component(Flags, MaybeWidth, Char, String).
%---------------------------------------------------------------------------%
format_string_component_nowidth_noprec(Flags, Str, String) :-
MaybeWidth = no_specified_width,
MaybePrec = no_specified_prec,
format_string_component(Flags, MaybeWidth, MaybePrec, Str, String).
format_string_component_nowidth_prec(Flags, Prec, Str, String) :-
MaybeWidth = no_specified_width,
MaybePrec = specified_prec(Prec),
format_string_component(Flags, MaybeWidth, MaybePrec, Str, String).
format_string_component_width_noprec(Flags, Width, Str, String) :-
MaybeWidth = specified_width(Width),
MaybePrec = no_specified_prec,
format_string_component(Flags, MaybeWidth, MaybePrec, Str, String).
format_string_component_width_prec(Flags, Width, Prec, Str, String) :-
MaybeWidth = specified_width(Width),
MaybePrec = specified_prec(Prec),
format_string_component(Flags, MaybeWidth, MaybePrec, Str, String).
%---------------------------------------------------------------------------%
format_signed_int_component_nowidth_noprec(Flags, Int, String) :-
MaybeWidth = no_specified_width,
MaybePrec = no_specified_prec,
format_signed_int_component(Flags, MaybeWidth, MaybePrec, Int, String).
format_signed_int_component_nowidth_prec(Flags, Prec, Int, String) :-
MaybeWidth = no_specified_width,
MaybePrec = specified_prec(Prec),
format_signed_int_component(Flags, MaybeWidth, MaybePrec, Int, String).
format_signed_int_component_width_noprec(Flags, Width, Int, String) :-
MaybeWidth = specified_width(Width),
MaybePrec = no_specified_prec,
format_signed_int_component(Flags, MaybeWidth, MaybePrec, Int, String).
format_signed_int_component_width_prec(Flags, Width, Prec, Int, String) :-
MaybeWidth = specified_width(Width),
MaybePrec = specified_prec(Prec),
format_signed_int_component(Flags, MaybeWidth, MaybePrec, Int, String).
%---------------------------------------------------------------------------%
format_uint_component_nowidth_noprec(Flags, Base, UInt, String) :-
MaybeWidth = no_specified_width,
MaybePrec = no_specified_prec,
format_uint_component(Flags, MaybeWidth, MaybePrec, Base, UInt,
String).
format_uint_component_nowidth_prec(Flags, Prec, Base, UInt, String) :-
MaybeWidth = no_specified_width,
MaybePrec = specified_prec(Prec),
format_uint_component(Flags, MaybeWidth, MaybePrec, Base, UInt,
String).
format_uint_component_width_noprec(Flags, Width, Base, UInt, String) :-
MaybeWidth = specified_width(Width),
MaybePrec = no_specified_prec,
format_uint_component(Flags, MaybeWidth, MaybePrec, Base, UInt,
String).
format_uint_component_width_prec(Flags, Width, Prec, Base, UInt,
String) :-
MaybeWidth = specified_width(Width),
MaybePrec = specified_prec(Prec),
format_uint_component(Flags, MaybeWidth, MaybePrec, Base, UInt,
String).
%---------------------------------------------------------------------------%
format_signed_int64_component_nowidth_noprec(Flags, Int64, String) :-
MaybeWidth = no_specified_width,
MaybePrec = no_specified_prec,
format_signed_int64_component(Flags, MaybeWidth, MaybePrec, Int64,
String).
format_signed_int64_component_nowidth_prec(Flags, Prec, Int64, String) :-
MaybeWidth = no_specified_width,
MaybePrec = specified_prec(Prec),
format_signed_int64_component(Flags, MaybeWidth, MaybePrec, Int64,
String).
format_signed_int64_component_width_noprec(Flags, Width, Int64, String) :-
MaybeWidth = specified_width(Width),
MaybePrec = no_specified_prec,
format_signed_int64_component(Flags, MaybeWidth, MaybePrec, Int64,
String).
format_signed_int64_component_width_prec(Flags, Width, Prec, Int64,
String) :-
MaybeWidth = specified_width(Width),
MaybePrec = specified_prec(Prec),
format_signed_int64_component(Flags, MaybeWidth, MaybePrec, Int64,
String).
%---------------------------------------------------------------------------%
format_unsigned_int64_component_nowidth_noprec(Flags, Base, Int64, String) :-
MaybeWidth = no_specified_width,
MaybePrec = no_specified_prec,
format_unsigned_int64_component(Flags, MaybeWidth, MaybePrec, Base, Int64,
String).
format_unsigned_int64_component_nowidth_prec(Flags, Prec, Base, Int64,
String) :-
MaybeWidth = no_specified_width,
MaybePrec = specified_prec(Prec),
format_unsigned_int64_component(Flags, MaybeWidth, MaybePrec, Base, Int64,
String).
format_unsigned_int64_component_width_noprec(Flags, Width, Base, Int64,
String) :-
MaybeWidth = specified_width(Width),
MaybePrec = no_specified_prec,
format_unsigned_int64_component(Flags, MaybeWidth, MaybePrec, Base, Int64,
String).
format_unsigned_int64_component_width_prec(Flags, Width, Prec, Base, Int64,
String) :-
MaybeWidth = specified_width(Width),
MaybePrec = specified_prec(Prec),
format_unsigned_int64_component(Flags, MaybeWidth, MaybePrec, Base, Int64,
String).
%---------------------------------------------------------------------------%
format_uint64_component_nowidth_noprec(Flags, Base, UInt64, String) :-
MaybeWidth = no_specified_width,
MaybePrec = no_specified_prec,
format_uint64_component(Flags, MaybeWidth, MaybePrec, Base, UInt64,
String).
format_uint64_component_nowidth_prec(Flags, Prec, Base, UInt64, String) :-
MaybeWidth = no_specified_width,
MaybePrec = specified_prec(Prec),
format_uint64_component(Flags, MaybeWidth, MaybePrec, Base, UInt64,
String).
format_uint64_component_width_noprec(Flags, Width, Base, UInt64, String) :-
MaybeWidth = specified_width(Width),
MaybePrec = no_specified_prec,
format_uint64_component(Flags, MaybeWidth, MaybePrec, Base, UInt64,
String).
format_uint64_component_width_prec(Flags, Width, Prec, Base, UInt64,
String) :-
MaybeWidth = specified_width(Width),
MaybePrec = specified_prec(Prec),
format_uint64_component(Flags, MaybeWidth, MaybePrec, Base, UInt64,
String).
%---------------------------------------------------------------------------%
format_float_component_nowidth_noprec(Flags, Kind, Float, String) :-
MaybeWidth = no_specified_width,
MaybePrec = no_specified_prec,
format_float_component(Flags, MaybeWidth, MaybePrec, Kind, Float, String).
format_float_component_nowidth_prec(Flags, Prec, Kind, Float, String) :-
MaybeWidth = no_specified_width,
MaybePrec = specified_prec(Prec),
format_float_component(Flags, MaybeWidth, MaybePrec, Kind, Float, String).
format_float_component_width_noprec(Flags, Width, Kind, Float, String) :-
MaybeWidth = specified_width(Width),
MaybePrec = no_specified_prec,
format_float_component(Flags, MaybeWidth, MaybePrec, Kind, Float, String).
format_float_component_width_prec(Flags, Width, Prec, Kind, Float, String) :-
MaybeWidth = specified_width(Width),
MaybePrec = specified_prec(Prec),
format_float_component(Flags, MaybeWidth, MaybePrec, Kind, Float, String).
%---------------------------------------------------------------------------%
:- pred format_char_component(string_format_flags::in,
string_format_maybe_width::in, char::in, string::out) is det.
format_char_component(Flags, MaybeWidth, Char, String) :-
( if using_sprintf_for_char(Char) then
FormatStr = make_format_sprintf(Flags, MaybeWidth, no_specified_prec,
"", "c"),
String = native_format_char(FormatStr, Char)
else
String = format_char(Flags, MaybeWidth, Char)
).
:- pred format_string_component(string_format_flags::in,
string_format_maybe_width::in, string_format_maybe_prec::in,
string::in, string::out) is det.
format_string_component(Flags, MaybeWidth, MaybePrec, Str, String) :-
( if
(
using_sprintf,
Flags = string_format_flags(flag_hash_clear, flag_space_clear,
flag_zero_clear, flag_minus_clear, flag_plus_clear),
MaybeWidth = no_specified_width,
MaybePrec = no_specified_prec
;
using_sprintf_for_string(Str)
)
then
FormatStr = make_format_sprintf(Flags, MaybeWidth, MaybePrec, "", "s"),
String = native_format_string(FormatStr, Str)
else
String = format_string(Flags, MaybeWidth, MaybePrec, Str)
).
:- pred format_signed_int_component(string_format_flags::in,
string_format_maybe_width::in, string_format_maybe_prec::in,
int::in, string::out) is det.
format_signed_int_component(Flags, MaybeWidth, MaybePrec, Int, String) :-
( if using_sprintf then
% XXX The "d" could be "i"; we don't keep track.
FormatStr = make_format_sprintf(Flags, MaybeWidth, MaybePrec,
int_length_modifier, "d"),
String = native_format_int(FormatStr, Int)
else
String = format_signed_int(Flags, MaybeWidth, MaybePrec, Int)
).
:- pred format_uint_component(string_format_flags::in,
string_format_maybe_width::in, string_format_maybe_prec::in,
string_format_int_base::in, uint::in, string::out) is det.
format_uint_component(Flags, MaybeWidth, MaybePrec, Base, UInt, String) :-
( if using_sprintf then
( Base = base_octal, SpecChar = "o"
; Base = base_decimal, SpecChar = "u"
; Base = base_hex_lc, SpecChar = "x"
; Base = base_hex_uc, SpecChar = "X"
; Base = base_hex_p, SpecChar = "p"
),
FormatStr = make_format_sprintf(Flags, MaybeWidth, MaybePrec,
int_length_modifier, SpecChar),
String = native_format_uint(FormatStr, UInt)
else
String = format_uint(Flags, MaybeWidth, MaybePrec, Base, UInt)
).
:- pred format_signed_int64_component(string_format_flags::in,
string_format_maybe_width::in, string_format_maybe_prec::in,
int64::in, string::out) is det.
format_signed_int64_component(Flags, MaybeWidth, MaybePrec, Int64, String) :-
( if using_sprintf then
FormatStr = make_format_sprintf(Flags, MaybeWidth, MaybePrec,
"", int64_decimal_specifier),
String = native_format_int64(FormatStr, Int64)
else
String = format_signed_int64(Flags, MaybeWidth, MaybePrec, Int64)
).
:- pred format_unsigned_int64_component(string_format_flags::in,
string_format_maybe_width::in, string_format_maybe_prec::in,
string_format_int_base::in, int64::in, string::out) is det.
format_unsigned_int64_component(Flags, MaybeWidth, MaybePrec, Base, Int64,
String) :-
( if using_sprintf then
( Base = base_octal, Spec = uint64_octal_specifier
; Base = base_decimal, Spec = uint64_decimal_specifier
; Base = base_hex_lc, Spec = uint64_hex_lc_specifier
; Base = base_hex_uc, Spec = uint64_hex_uc_specifier
; Base = base_hex_p, Spec = uint64_hex_p_specifier
),
FormatStr = make_format_sprintf(Flags, MaybeWidth, MaybePrec,
"", Spec),
String = native_format_int64(FormatStr, Int64)
else
UInt64 = uint64.cast_from_int64(Int64),
String = format_uint64(Flags, MaybeWidth, MaybePrec, Base, UInt64)
).
:- pred format_uint64_component(string_format_flags::in,
string_format_maybe_width::in, string_format_maybe_prec::in,
string_format_int_base::in, uint64::in, string::out) is det.
format_uint64_component(Flags, MaybeWidth, MaybePrec, Base, UInt64, String) :-
( if using_sprintf then
( Base = base_octal, Spec = uint64_octal_specifier
; Base = base_decimal, Spec = uint64_decimal_specifier
; Base = base_hex_lc, Spec = uint64_hex_lc_specifier
; Base = base_hex_uc, Spec = uint64_hex_uc_specifier
; Base = base_hex_p, Spec = uint64_hex_p_specifier
),
FormatStr = make_format_sprintf(Flags, MaybeWidth, MaybePrec,
"", Spec),
String = native_format_uint64(FormatStr, UInt64)
else
String = format_uint64(Flags, MaybeWidth, MaybePrec, Base, UInt64)
).
:- pred format_float_component(string_format_flags::in,
string_format_maybe_width::in, string_format_maybe_prec::in,
string_format_float_kind::in, float::in, string::out) is det.
format_float_component(Flags, MaybeWidth, MaybePrec, Kind, Float, String) :-
( if
is_finite(Float),
using_sprintf
then
( Kind = kind_e_scientific_lc, SpecChar = "e"
; Kind = kind_e_scientific_uc, SpecChar = "E"
; Kind = kind_f_plain_lc, SpecChar = "f"
; Kind = kind_f_plain_uc, SpecChar = "F"
; Kind = kind_g_flexible_lc, SpecChar = "g"
; Kind = kind_g_flexible_uc, SpecChar = "G"
),
FormatStr = make_format_sprintf(Flags, MaybeWidth, MaybePrec,
"", SpecChar),
String = native_format_float(FormatStr, Float)
else
String = format_float(Flags, MaybeWidth, MaybePrec, Kind, Float)
).
%---------------------------------------------------------------------------%
% Are we using C's sprintf? All backends other than C return false.
% Note that any backends which return true for using_sprintf/0 must
% also implement:
%
% int_length_modifier/0
% native_format_float/2
% native_format_int/2
% native_format_string/2
% native_format_char/2
% native_format_uint/2
% native_format_int64/2
% native_format_uint64/2
%
:- pred using_sprintf is semidet.
:- pragma foreign_proc("C", using_sprintf,
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
SUCCESS_INDICATOR = ML_USE_SPRINTF;
").
:- pragma foreign_proc("C#", using_sprintf,
[will_not_call_mercury, promise_pure, thread_safe],
"
SUCCESS_INDICATOR = false;
").
:- pragma foreign_proc("Java", using_sprintf,
[will_not_call_mercury, promise_pure, thread_safe],
"
SUCCESS_INDICATOR = false;
").
:- pred using_sprintf_for_char(char::in) is semidet.
using_sprintf_for_char(_) :-
semidet_fail.
:- pragma foreign_proc("C",
using_sprintf_for_char(Char::in),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
// sprintf %c specifier is inadequate for multi-byte UTF-8 characters.
SUCCESS_INDICATOR = ML_USE_SPRINTF && MR_is_ascii(Char);
").
:- pred using_sprintf_for_string(string::in) is semidet.
using_sprintf_for_string(_) :-
semidet_fail.
:- pragma foreign_proc("C",
using_sprintf_for_string(Str::in),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
const char *s;
SUCCESS_INDICATOR = ML_USE_SPRINTF;
for (s = Str; *s != '\\0'; s++) {
// sprintf %s specifier is inadequate for multi-byte UTF-8 characters,
// if there is a field width or precision specified.
if (!MR_utf8_is_single_byte(*s)) {
SUCCESS_INDICATOR = MR_FALSE;
break;
}
}
").
% Construct a format string suitable to passing to sprintf.
%
:- func make_format_sprintf(string_format_flags, string_format_maybe_width,
string_format_maybe_prec, string, string) = string.
make_format_sprintf(Flags, MaybeWidth, MaybePrec, LengthMod, Spec) = String :-
Flags = string_format_flags(FlagHash, FlagSpace, FlagZero,
FlagMinus, FlagPlus),
( FlagHash = flag_hash_clear, FlagHashStr = ""
; FlagHash = flag_hash_set, FlagHashStr = "#"
),
( FlagSpace = flag_space_clear, FlagSpaceStr = ""
; FlagSpace = flag_space_set, FlagSpaceStr = " "
),
( FlagZero = flag_zero_clear, FlagZeroStr = ""
; FlagZero = flag_zero_set, FlagZeroStr = "0"
),
( FlagMinus = flag_minus_clear, FlagMinusStr = ""
; FlagMinus = flag_minus_set, FlagMinusStr = "-"
),
( FlagPlus = flag_plus_clear, FlagPlusStr = ""
; FlagPlus = flag_plus_set, FlagPlusStr = "+"
),
(
MaybeWidth = specified_width(Width),
WidthStr = int_to_string(Width)
;
MaybeWidth = no_specified_width,
WidthStr = ""
),
(
MaybePrec = specified_prec(Prec),
PrecPrefixStr = ".",
PrecStr = int_to_string(Prec)
;
MaybePrec = no_specified_prec,
PrecPrefixStr = "",
PrecStr = ""
),
String = string.append_list(["%",
FlagHashStr, FlagSpaceStr, FlagZeroStr, FlagMinusStr, FlagPlusStr,
WidthStr, PrecPrefixStr, PrecStr, LengthMod, Spec]).
:- func int_length_modifier = string.
:- pragma no_determinism_warning(func(int_length_modifier/0)).
:- pragma foreign_proc("C",
int_length_modifier = (LengthModifier::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"{
MR_make_aligned_string(LengthModifier, MR_INTEGER_LENGTH_MODIFIER);
}").
int_length_modifier = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.int_length_modifier/0 not defined").
% NOTE: C does not provide a way to determine the length modifier for the
% intN_t and uintN_t types in isolation. For int64s, the [oxXup] specifiers
% are all handled by casting to a uint64.
:- func int64_decimal_specifier = string.
:- pragma no_determinism_warning(func(int64_decimal_specifier/0)).
:- pragma foreign_proc("C",
int64_decimal_specifier = (Spec::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
MR_make_aligned_string(Spec, PRId64);
").
int64_decimal_specifier = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.int64_decimal_specifier/0 not defined").
:- func uint64_octal_specifier = string.
:- pragma no_determinism_warning(func(uint64_octal_specifier/0)).
:- pragma foreign_proc("C",
uint64_octal_specifier = (Spec::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
MR_make_aligned_string(Spec, PRIo64);
").
uint64_octal_specifier = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.uint64_octal_specifier/0 not defined").
:- func uint64_decimal_specifier = string.
:- pragma no_determinism_warning(func(uint64_decimal_specifier/0)).
:- pragma foreign_proc("C",
uint64_decimal_specifier = (Spec::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
MR_make_aligned_string(Spec, PRIu64);
").
uint64_decimal_specifier = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.uint64_decimal_specifier/0 not defined").
:- func uint64_hex_lc_specifier = string.
:- pragma no_determinism_warning(func(uint64_hex_lc_specifier/0)).
:- pragma foreign_proc("C",
uint64_hex_lc_specifier = (Spec::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
MR_make_aligned_string(Spec, PRIx64);
").
uint64_hex_lc_specifier = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.uint64_hex_lc_specifier/0 not defined").
:- func uint64_hex_uc_specifier = string.
:- pragma no_determinism_warning(func(uint64_hex_uc_specifier/0)).
:- pragma foreign_proc("C",
uint64_hex_uc_specifier = (Spec::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
MR_make_aligned_string(Spec, PRIX64);
").
uint64_hex_uc_specifier = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.uint64_hex_uc_specifier/0 not defined").
% C does not define the 'p' specifier for uint64_t, so we just treat it as
% hexadecimal here. What that specifier does is implementation defined
% in C anyway.
:- func uint64_hex_p_specifier = string.
uint64_hex_p_specifier =
uint64_hex_lc_specifier.
% Create a string from a float using the format string.
% Note it is the responsibility of the caller to ensure that the
% format string is valid.
%
:- func native_format_float(string, float) = string.
:- pragma no_determinism_warning(func(native_format_float/2)).
:- pragma foreign_proc("C",
native_format_float(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"{
MR_save_transient_hp();
Str = MR_make_string(MR_ALLOC_ID, FormatStr, (double) Val);
MR_restore_transient_hp();
}").
native_format_float(_, _) = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.native_format_float/2 not defined").
% Create a string from an int using the format string.
% Note it is the responsibility of the caller to ensure that the
% format string is valid.
%
:- func native_format_int(string, int) = string.
:- pragma no_determinism_warning(func(native_format_int/2)).
:- pragma foreign_proc("C",
native_format_int(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"{
MR_save_transient_hp();
Str = MR_make_string(MR_ALLOC_ID, FormatStr, Val);
MR_restore_transient_hp();
}").
native_format_int(_, _) = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.native_format_int/2 not defined").
% Create a string from a uint using the format string.
% Note it is the responsibility of the caller to ensure that the
% format string is valid.
%
:- func native_format_uint(string, uint) = string.
:- pragma no_determinism_warning(func(native_format_uint/2)).
:- pragma foreign_proc("C",
native_format_uint(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"{
MR_save_transient_hp();
Str = MR_make_string(MR_ALLOC_ID, FormatStr, Val);
MR_restore_transient_hp();
}").
native_format_uint(_, _) = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.native_format_uint/2 not defined").
:- func native_format_int64(string, int64) = string.
:- pragma no_determinism_warning(func(native_format_int64/2)).
:- pragma foreign_proc("C",
native_format_int64(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"{
MR_save_transient_hp();
Str = MR_make_string(MR_ALLOC_ID, FormatStr, Val);
MR_restore_transient_hp();
}").
native_format_int64(_, _) = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.native_format_int64/2 not defined").
:- func native_format_uint64(string, uint64) = string.
:- pragma no_determinism_warning(func(native_format_uint64/2)).
:- pragma foreign_proc("C",
native_format_uint64(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"{
MR_save_transient_hp();
Str = MR_make_string(MR_ALLOC_ID, FormatStr, Val);
MR_restore_transient_hp();
}").
native_format_uint64(_, _) = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.native_format_uint64/2 not defined").
% Create a string from a string using the format string.
% Note it is the responsibility of the caller to ensure that the
% format string is valid.
%
:- func native_format_string(string, string) = string.
:- pragma no_determinism_warning(func(native_format_string/2)).
:- pragma foreign_proc("C",
native_format_string(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"{
MR_save_transient_hp();
Str = MR_make_string(MR_ALLOC_ID, FormatStr, Val);
MR_restore_transient_hp();
}").
native_format_string(_, _) = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.native_format_string/2 not defined").
% Create a string from a char using the format string.
% Note it is the responsibility of the caller to ensure that the
% format string is valid.
%
:- func native_format_char(string, char) = string.
:- pragma no_determinism_warning(func(native_format_char/2)).
:- pragma foreign_proc("C",
native_format_char(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"{
MR_save_transient_hp();
Str = MR_make_string(MR_ALLOC_ID, FormatStr, Val);
MR_restore_transient_hp();
}").
native_format_char(_, _) = _ :-
% This predicate is only called if using_sprintf/0, so we produce an error
% by default.
error("string.native_format_char/2 not defined").
%---------------------------------------------------------------------------%
% Format a character.
%
:- func format_char(string_format_flags, string_format_maybe_width, char)
= string.
format_char(Flags, MaybeWidth, Char) = String :-
CharStr = string.char_to_string(Char),
String = justify_string(Flags, MaybeWidth, CharStr).
%---------------------------------------------------------------------------%
% Format a string.
%
:- func format_string(string_format_flags, string_format_maybe_width,
string_format_maybe_prec, string) = string.
format_string(Flags, MaybeWidth, MaybePrec, OldStr) = NewStr :-
(
MaybePrec = specified_prec(NumChars),
PrecStr = string.left_by_code_point(OldStr, NumChars)
;
MaybePrec = no_specified_prec,
PrecStr = OldStr
),
NewStr = justify_string(Flags, MaybeWidth, PrecStr).
%---------------------------------------------------------------------------%
% Format an int (as a signed value).
%
:- func format_signed_int(string_format_flags, string_format_maybe_width,
string_format_maybe_prec, int) = string.
format_signed_int(Flags, MaybeWidth, MaybePrec, Int) = String :-
( if Int = 0 then
% Zero is a special case. The abs_integer_to_decimal function
% returns "" for 0, but returning no digits at all is ok
% only if our caller explicitly allowed us to do so.
( if MaybePrec = specified_prec(0) then
AbsIntStr = ""
else
AbsIntStr = "0"
)
else
% In the general case, we use the arbitrary-precision arithmetic
% of integer.m to print integers. This is needed to print
% the most negative number of our platform, whose absolute value
% cannot be represented natively on machines with two's complement
% integers.
% However, if the absolute value of the integer we want to print
% *does* fit into a native int, we want to work on ints, not integers.
% We assume that our platform has at least 32 bit ints; note that
% 2147483647 = 2^31-1. The "absolute value of" part of the above
% is why the test is designed to fail for -2147483648.
( if -2147483647 =< Int, Int =< 2147483647 then
AbsInt = int.abs(Int),
AbsIntStr = abs_int_to_decimal(AbsInt)
else
AbsInteger = integer.abs(integer(Int)),
AbsIntStr = abs_integer_to_decimal(AbsInteger)
)
),
AbsIntStrLength = string.count_code_points(AbsIntStr),
% Do we need to increase precision?
( if
MaybePrec = specified_prec(Prec),
Prec > AbsIntStrLength
then
PrecStr = string.pad_left(AbsIntStr, '0', Prec)
else
PrecStr = AbsIntStr
),
% Do we need to pad to the field width?
( if
MaybeWidth = specified_width(Width),
Width > string.count_code_points(PrecStr),
Flags ^ flag_zero = flag_zero_set,
Flags ^ flag_minus = flag_minus_clear,
MaybePrec = no_specified_prec
then
FieldStr = string.pad_left(PrecStr, '0', Width - 1),
ZeroPadded = yes
else
FieldStr = PrecStr,
ZeroPadded = no
),
% Prefix with appropriate sign or zero padding.
% The previous step has deliberately left room for this.
SignedStr = add_sign_like_prefix_to_int_if_needed(Flags, ZeroPadded, Int,
FieldStr),
String = justify_string(Flags, MaybeWidth, SignedStr).
%---------------------------------------------------------------------------%
% Format a uint.
% Also used for formatting ints as unsigned values.
%
:- func format_uint(string_format_flags, string_format_maybe_width,
string_format_maybe_prec, string_format_int_base, uint) = string.
format_uint(Flags, MaybeWidth, MaybePrec, Base, UInt) = String :-
( if UInt = 0u then
% Zero is a special case, the uint_to_*string functions return "0" for
% 0, but we must return "" if our caller explicitly allowed us to do
% so.
( if MaybePrec = specified_prec(0) then
UIntStr = ""
else
UIntStr = "0"
)
else
(
Base = base_octal,
UIntStr = uint_to_octal_string(UInt)
;
Base = base_decimal,
UIntStr = uint_to_string(UInt)
;
( Base = base_hex_lc
; Base = base_hex_p
),
UIntStr = uint_to_lc_hex_string(UInt)
;
Base = base_hex_uc,
UIntStr = uint_to_uc_hex_string(UInt)
)
),
UIntStrLength = string.count_code_points(UIntStr),
% Do we need to increase precision?
( if
MaybePrec = specified_prec(Prec),
Prec > UIntStrLength
then
PrecStr = string.pad_left(UIntStr, '0', Prec)
else
PrecStr = UIntStr
),
% Do we need to increase the precision of an octal?
( if
Base = base_octal,
Flags ^ flag_hash = flag_hash_set,
not string.prefix(PrecStr, "0")
then
PrecModStr = "0" ++ PrecStr
else
PrecModStr = PrecStr
),
% Do we need to pad to the field width?
( if
MaybeWidth = specified_width(Width),
Width > string.count_code_points(PrecModStr),
Flags ^ flag_zero = flag_zero_set,
Flags ^ flag_minus = flag_minus_clear,
MaybePrec = no_specified_prec
then
% Do we need to make room for "0x" or "0X" ?
( if
Flags ^ flag_hash = flag_hash_set,
require_complete_switch [Base]
(
Base = base_hex_p,
Prefix = "0x"
;
Base = base_hex_lc,
UInt \= 0u,
Prefix = "0x"
;
Base = base_hex_uc,
UInt \= 0u,
Prefix = "0X"
;
( Base = base_octal
; Base = base_decimal
),
% These get padded with just zeroes on the left.
fail
)
then
FieldStr = string.pad_left(PrecModStr, '0', Width - 2),
FieldModStr = Prefix ++ FieldStr
else
FieldStr = string.pad_left(PrecModStr, '0', Width),
FieldModStr = FieldStr
)
else
FieldStr = PrecModStr,
% Do we have to prefix "0x" or "0X"?
( if
Flags ^ flag_hash = flag_hash_set,
require_complete_switch [Base]
(
Base = base_hex_p,
Prefix = "0x"
;
Base = base_hex_lc,
UInt \= 0u,
Prefix = "0x"
;
Base = base_hex_uc,
UInt \= 0u,
Prefix = "0X"
;
Base = base_octal,
% We took care of adding the "0" prefix above.
fail
;
Base = base_decimal,
fail
)
then
FieldModStr = Prefix ++ FieldStr
else
FieldModStr = FieldStr
)
),
String = justify_string(Flags, MaybeWidth, FieldModStr).
%---------------------------------------------------------------------------%
% Format an int64 (as a signed value).
%
:- func format_signed_int64(string_format_flags, string_format_maybe_width,
string_format_maybe_prec, int64) = string.
format_signed_int64(Flags, MaybeWidth, MaybePrec, Int) = String :-
( if Int = 0i64 then
% Zero is a special case, int64_to_string returns "0" for 0, but we
% must return "" only if our caller explicitly allowed us to do so.
( if MaybePrec = specified_prec(0) then
AbsIntStr = ""
else
AbsIntStr = "0"
)
else if Int = int64.min_int64 then
AbsIntStr = "9223372036854775808"
else
AbsInt = int64.unchecked_abs(Int),
AbsIntStr = int64_to_string(AbsInt)
),
AbsIntStrLength = string.count_code_points(AbsIntStr),
% Do we need to increase precision?
( if
MaybePrec = specified_prec(Prec),
Prec > AbsIntStrLength
then
PrecStr = string.pad_left(AbsIntStr, '0', Prec)
else
PrecStr = AbsIntStr
),
% Do we need to pad to the field width?
( if
MaybeWidth = specified_width(Width),
Width > string.count_code_points(PrecStr),
Flags ^ flag_zero = flag_zero_set,
Flags ^ flag_minus = flag_minus_clear,
MaybePrec = no_specified_prec
then
FieldStr = string.pad_left(PrecStr, '0', Width - 1),
ZeroPadded = yes
else
FieldStr = PrecStr,
ZeroPadded = no
),
% Prefix with appropriate sign or zero padding.
% The previous step has deliberately left room for this.
SignedStr = add_sign_like_prefix_to_int64_if_needed(Flags, ZeroPadded, Int,
FieldStr),
String = justify_string(Flags, MaybeWidth, SignedStr).
%---------------------------------------------------------------------------%
% Format a uint64.
% Also used for formatting int64s as unsigned values.
%
:- func format_uint64(string_format_flags, string_format_maybe_width,
string_format_maybe_prec, string_format_int_base, uint64) = string.
format_uint64(Flags, MaybeWidth, MaybePrec, Base, UInt64) = String :-
( if UInt64 = 0u64 then
% Zero is a special case, the uint64_to_*string functions return "0"
% for 0, but we must return "" only if our caller explicitly allowed us
% to do so.
( if MaybePrec = specified_prec(0) then
UInt64Str = ""
else
UInt64Str = "0"
)
else
(
Base = base_octal,
UInt64Str = uint64_to_octal_string(UInt64)
;
Base = base_decimal,
UInt64Str = uint64_to_string(UInt64)
;
( Base = base_hex_lc
; Base = base_hex_p
),
UInt64Str = uint64_to_lc_hex_string(UInt64)
;
Base = base_hex_uc,
UInt64Str = uint64_to_uc_hex_string(UInt64)
)
),
UInt64StrLength = string.count_code_points(UInt64Str),
% Do we need to increase precision?
( if
MaybePrec = specified_prec(Prec),
Prec > UInt64StrLength
then
PrecStr = string.pad_left(UInt64Str, '0', Prec)
else
PrecStr = UInt64Str
),
% Do we need to increase the precision of an octal?
( if
Base = base_octal,
Flags ^ flag_hash = flag_hash_set,
not string.prefix(PrecStr, "0")
then
PrecModStr = "0" ++ PrecStr
else
PrecModStr = PrecStr
),
% Do we need to pad to the field width?
( if
MaybeWidth = specified_width(Width),
Width > string.count_code_points(PrecModStr),
Flags ^ flag_zero = flag_zero_set,
Flags ^ flag_minus = flag_minus_clear,
MaybePrec = no_specified_prec
then
% Do we need to make room for "0x" or "0X" ?
( if
Flags ^ flag_hash = flag_hash_set,
require_complete_switch [Base]
(
Base = base_hex_p,
Prefix = "0x"
;
Base = base_hex_lc,
UInt64 \= 0u64,
Prefix = "0x"
;
Base = base_hex_uc,
UInt64 \= 0u64,
Prefix = "0X"
;
( Base = base_octal
; Base = base_decimal
),
% These get padded with just zeroes on the left.
fail
)
then
FieldStr = string.pad_left(PrecModStr, '0', Width - 2),
FieldModStr = Prefix ++ FieldStr
else
FieldStr = string.pad_left(PrecModStr, '0', Width),
FieldModStr = FieldStr
)
else
FieldStr = PrecModStr,
% Do we have to prefix "0x" or "0X"?
( if
Flags ^ flag_hash = flag_hash_set,
require_complete_switch [Base]
(
Base = base_hex_p,
Prefix = "0x"
;
Base = base_hex_lc,
UInt64 \= 0u64,
Prefix = "0x"
;
Base = base_hex_uc,
UInt64 \= 0u64,
Prefix = "0X"
;
Base = base_octal,
% We took care of adding the "0" prefix above.
fail
;
Base = base_decimal,
fail
)
then
FieldModStr = Prefix ++ FieldStr
else
FieldModStr = FieldStr
)
),
String = justify_string(Flags, MaybeWidth, FieldModStr).
%---------------------------------------------------------------------------%
% Format a float.
%
:- func format_float(string_format_flags, string_format_maybe_width,
string_format_maybe_prec, string_format_float_kind, float) = string.
format_float(Flags, MaybeWidth, MaybePrec, Kind, Float) = String :-
( if is_nan(Float) then
(
( Kind = kind_e_scientific_lc
; Kind = kind_f_plain_lc
; Kind = kind_g_flexible_lc
),
SignedStr = "nan"
;
( Kind = kind_e_scientific_uc
; Kind = kind_f_plain_uc
; Kind = kind_g_flexible_uc
),
SignedStr = "NAN"
)
else if is_infinite(Float) then
(
( Kind = kind_e_scientific_lc
; Kind = kind_f_plain_lc
; Kind = kind_g_flexible_lc
),
SignedStr = ( if Float < 0.0 then "-infinity" else "infinity" )
;
( Kind = kind_e_scientific_uc
; Kind = kind_f_plain_uc
; Kind = kind_g_flexible_uc
),
SignedStr = ( if Float < 0.0 then "-INFINITY" else "INFINITY" )
)
else
% XXX This general approach of converting the float to a string
% using convert_float_to_string and then post-processing it
% is far from ideal, since it is significantly less efficient
% than building the right string directly.
AbsFloat = abs(Float),
AbsStr = convert_float_to_string(AbsFloat),
% Change precision if needed.
(
( Kind = kind_e_scientific_lc, E = "e"
; Kind = kind_e_scientific_uc, E = "E"
),
Prec = get_prec_to_use(MaybePrec),
PrecStr = change_to_e_notation(AbsStr, Prec, E),
% Do we need to remove the decimal point?
( if
Flags ^ flag_hash = flag_hash_clear,
MaybePrec = specified_prec(0)
then
split_at_decimal_point(PrecStr, BaseStr, ExponentStr),
PrecModStr = BaseStr ++ ExponentStr
else
PrecModStr = PrecStr
)
;
( Kind = kind_f_plain_lc
; Kind = kind_f_plain_uc
),
Prec = get_prec_to_use(MaybePrec),
PrecStr = change_precision(AbsStr, Prec),
% Do we need to remove the decimal point?
( if
Flags ^ flag_hash = flag_hash_clear,
MaybePrec = specified_prec(0)
then
PrecStrLen = string.count_code_points(PrecStr),
PrecModStr = string.between(PrecStr, 0, PrecStrLen - 1)
else
PrecModStr = PrecStr
)
;
( Kind = kind_g_flexible_lc, E = "e"
; Kind = kind_g_flexible_uc, E = "E"
),
Prec = get_prec_to_use_minimum_1(MaybePrec),
PrecStr = change_to_g_notation(AbsStr, Prec, E, Flags),
% Don't ever remove the decimal point.
% XXX Why? Does change_to_g_notation do it?
PrecModStr = PrecStr
),
% Do we need to change field width?
( if
MaybeWidth = specified_width(Width),
Width > string.count_code_points(PrecModStr),
Flags ^ flag_zero = flag_zero_set,
Flags ^ flag_minus = flag_minus_clear
then
FieldStr = string.pad_left(PrecModStr, '0', Width - 1),
ZeroPadded = yes
else
FieldStr = PrecModStr,
ZeroPadded = no
),
% Finishing up.
SignedStr = add_sign_like_prefix_to_float_if_needed(Flags, ZeroPadded,
Float, FieldStr)
),
String = justify_string(Flags, MaybeWidth, SignedStr).
%---------------------------------------------------------------------------%
:- func get_prec_to_use(string_format_maybe_prec) = int.
:- pragma inline(func(get_prec_to_use/1)).
get_prec_to_use(MaybePrec) = Prec :-
(
MaybePrec = specified_prec(Prec)
;
MaybePrec = no_specified_prec,
% The default precision is 6.
Prec = 6
).
:- func get_prec_to_use_minimum_1(string_format_maybe_prec) = int.
:- pragma inline(func(get_prec_to_use_minimum_1/1)).
get_prec_to_use_minimum_1(MaybePrec) = Prec :-
(
MaybePrec = specified_prec(Prec0),
( if Prec0 = 0 then
Prec = 1
else
Prec = Prec0
)
;
MaybePrec = no_specified_prec,
% The default precision is 6.
Prec = 6
).
%---------------------------------------------------------------------------%
:- func add_sign_like_prefix_to_int_if_needed(string_format_flags, bool,
int, string) = string.
:- pragma inline(func(add_sign_like_prefix_to_int_if_needed/4)).
add_sign_like_prefix_to_int_if_needed(Flags, ZeroPadded, Int, FieldStr)
= SignedStr :-
( if Int < 0 then
SignedStr = "-" ++ FieldStr
else if Flags ^ flag_plus = flag_plus_set then
SignedStr = "+" ++ FieldStr
else if Flags ^ flag_space = flag_space_set then
SignedStr = " " ++ FieldStr
else
(
ZeroPadded = yes,
SignedStr = "0" ++ FieldStr
;
ZeroPadded = no,
SignedStr = FieldStr
)
).
:- func add_sign_like_prefix_to_int64_if_needed(string_format_flags, bool,
int64, string) = string.
:- pragma inline(func(add_sign_like_prefix_to_int64_if_needed/4)).
add_sign_like_prefix_to_int64_if_needed(Flags, ZeroPadded, Int64, FieldStr)
= SignedStr :-
( if int64.(Int64 < 0i64) then
SignedStr = "-" ++ FieldStr
else if Flags ^ flag_plus = flag_plus_set then
SignedStr = "+" ++ FieldStr
else if Flags ^ flag_space = flag_space_set then
SignedStr = " " ++ FieldStr
else
(
ZeroPadded = yes,
SignedStr = "0" ++ FieldStr
;
ZeroPadded = no,
SignedStr = FieldStr
)
).
:- func add_sign_like_prefix_to_float_if_needed(string_format_flags, bool,
float, string) = string.
:- pragma inline(func(add_sign_like_prefix_to_float_if_needed/4)).
add_sign_like_prefix_to_float_if_needed(Flags, ZeroPadded, Float, FieldStr)
= SignedStr :-
% XXX Float < 0.0 is the wrong test, because it fails for -0.0.
% We should test the sign bit instead. This can be done using
% signbit(Float) in C, but I (zs) don't know its equivalents
% for the other backends.
( if Float < 0.0 then
SignedStr = "-" ++ FieldStr
else if Flags ^ flag_plus = flag_plus_set then
SignedStr = "+" ++ FieldStr
else if Flags ^ flag_space = flag_space_set then
SignedStr = " " ++ FieldStr
else
(
ZeroPadded = yes,
SignedStr = "0" ++ FieldStr
;
ZeroPadded = no,
SignedStr = FieldStr
)
).
:- func justify_string(string_format_flags, string_format_maybe_width,
string) = string.
justify_string(Flags, MaybeWidth, Str) = JustifiedStr :-
( if
MaybeWidth = specified_width(Width),
Width > string.count_code_points(Str)
then
( if Flags ^ flag_minus = flag_minus_set then
string.pad_right(Str, ' ', Width, JustifiedStr)
else
string.pad_left(Str, ' ', Width, JustifiedStr)
)
else
JustifiedStr = Str
).
%---------------------------------------------------------------------------%
%
% Each of these functions converts a non-negative integer (that originally
% came from a Mercury int) to a string of octal, decimal or hex digits.
%
% The input is an arbitrary precision integer because if either
%
% - the original number is a signed int, and its value is min_int, or
% - the original number is an unsigned int, and its value has the most
% significant bit set,
%
% then the absolute value of that number cannot be represented as
% a Mercury int, which is always signed and always word-sized. However,
% once we have divided the original integer by 8, 10 or 16, the result
% is guaranteed not to suffer from either of the problems above,
% so we process it as an Mercury int, which is a lot faster.
% Convert a non-negative integer to a decimal string.
%
:- func abs_integer_to_decimal(integer) = string.
abs_integer_to_decimal(Num) = NumStr :-
( if Num > integer.zero then
Integer10 = integer.ten,
FrontDigitsStr = abs_int_to_decimal(det_to_int(Num // Integer10)),
LastDigitStr = get_decimal_digit(det_to_int(Num rem Integer10)),
NumStr = append(FrontDigitsStr, LastDigitStr)
else
NumStr = ""
).
:- func abs_int_to_decimal(int) = string.
abs_int_to_decimal(Num) = NumStr :-
( if Num > 0 then
FrontDigitsStr = abs_int_to_decimal(Num // 10),
LastDigitStr = get_decimal_digit(Num rem 10),
NumStr = append(FrontDigitsStr, LastDigitStr)
else
NumStr = ""
).
%---------------------------------------------------------------------------%
% Given an int between 0 and 9, return the decimal digit representing it.
%
:- func get_decimal_digit(int) = string.
:- pragma inline(func(get_decimal_digit/1)).
get_decimal_digit(Int) = Decimal :-
( if decimal_digit(Int, DecimalPrime) then
Decimal = DecimalPrime
else
unexpected($pred, "decimal_digit failed")
).
:- pred decimal_digit(int::in, string::out) is semidet.
decimal_digit(0, "0").
decimal_digit(1, "1").
decimal_digit(2, "2").
decimal_digit(3, "3").
decimal_digit(4, "4").
decimal_digit(5, "5").
decimal_digit(6, "6").
decimal_digit(7, "7").
decimal_digit(8, "8").
decimal_digit(9, "9").
%---------------------------------------------------------------------------%
% Unlike the standard library function, this function converts a float
% to a string without resorting to scientific notation.
%
% This predicate relies on the fact that string.float_to_string returns
% a float which is round-trippable, ie to the full precision needed.
%
:- func convert_float_to_string(float) = string.
convert_float_to_string(Float) = String :-
float_to_string_first_pass(Float, FloatStr),
% Check for scientific representation.
( if
( string.contains_char(FloatStr, 'e')
; string.contains_char(FloatStr, 'E')
)
then
split_at_exponent(FloatStr, FloatPtStr, ExpStr),
split_at_decimal_point(FloatPtStr, MantissaStr, FractionStr),
% What is the exponent?
ExpInt = string.det_to_int(ExpStr),
( if ExpInt >= 0 then
% Move decimal pt to the right.
ExtraDigits = ExpInt,
PaddedFracStr = string.pad_right(FractionStr, '0', ExtraDigits),
string.split(PaddedFracStr, ExtraDigits, MantissaRest,
NewFraction),
NewMantissa = MantissaStr ++ MantissaRest,
MantAndPoint = NewMantissa ++ ".",
( if NewFraction = "" then
String = MantAndPoint ++ "0"
else
String = MantAndPoint ++ NewFraction
)
else
% Move decimal pt to the left.
ExtraDigits = abs(ExpInt),
PaddedMantissaStr = string.pad_left(MantissaStr, '0',
ExtraDigits),
string.split(PaddedMantissaStr,
length(PaddedMantissaStr) - ExtraDigits,
NewMantissa, FractionRest),
( if NewMantissa = "" then
MantAndPoint = "0."
else
MantAndPoint = NewMantissa ++ "."
),
String = MantAndPoint ++ FractionRest ++ FractionStr
)
else
String = FloatStr
).
% float_to_string_first_pass differs from string.float_to_string in that
% it must be implemented without calling string.format, as this is the
% predicate that the implementation of string.format uses to get
% the initial string representation of a float.
%
% The string returned must match one of the following regular expression:
% ^[+-]?[0-9]*\.?[0-9]+((e|E)[0-9]+)?$
% ^[nN][aA][nN]$
% ^[+-]?[iI][nN][fF][iI][nN][iI][tT][yY]$
% ^[+-]?[iI][nN][fF]$
% and the string returned must have sufficient precision for representing
% the float.
%
:- pred float_to_string_first_pass(float::in, string::uo) is det.
:- pragma foreign_proc("C",
float_to_string_first_pass(FloatVal::in, FloatString::uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"{
// Note any changes here will require the same changes in
// string.float_to_string.
MR_float_to_string(FloatVal, FloatString, MR_ALLOC_ID);
}").
:- pragma foreign_proc("C#",
float_to_string_first_pass(FloatVal::in, FloatString::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
// The R format string prints the double out such that it can be
// round-tripped.
// XXX According to the documentation it tries 15 digits of precision,
// then 17 digits skipping 16 digits of precision, unlike what we do
// for the C backend.
FloatString = FloatVal.ToString(""R"");
").
:- pragma foreign_proc("Java",
float_to_string_first_pass(FloatVal::in, FloatString::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
FloatString = java.lang.Double.toString(FloatVal);
").
% Converts a floating point number to a specified number of standard
% figures. The style used depends on the value converted; style e (or E)
% is used only if the exponent resulting from such a conversion is less
% than -4 or greater than or equal to the precision. Trailing zeros are
% removed from the fractional portion of the result unless the # flag
% is specified: a decimal-point character appears only if it is followed
% by a digit.
%
:- func change_to_g_notation(string, int, string, string_format_flags)
= string.
change_to_g_notation(Float, Prec, E, Flags) = FormattedFloat :-
Exponent = size_of_required_exponent(Float, Prec),
( if
Exponent >= -4,
Exponent < Prec
then
% Float will be represented normally.
% -----------------------------------
% We need to calculate precision to pass to change_precision,
% because the current precision represents significant figures,
% not decimal places.
%
% Now change float's precision.
%
( if Exponent =< 0 then
% Deal with floats such as 0.00000000xyz.
DecimalPos = decimal_pos(Float),
FormattedFloat0 = change_precision(Float,
abs(DecimalPos) - 1 + Prec)
else
% Deal with floats such as ddddddd.mmmmmmmm.
ScientificFloat = change_to_e_notation(Float, Prec - 1, "e"),
split_at_exponent(ScientificFloat, BaseStr, ExponentStr),
Exp = string.det_to_int(ExponentStr),
split_at_decimal_point(BaseStr, MantissaStr, FractionStr),
RestMantissaStr = between(FractionStr, 0, Exp),
NewFraction = between(FractionStr, Exp, Prec - 1),
FormattedFloat0 = MantissaStr ++ RestMantissaStr
++ "." ++ NewFraction
),
% Do we remove trailing zeros?
( if Flags ^ flag_hash = flag_hash_set then
FormattedFloat = FormattedFloat0
else
FormattedFloat = remove_trailing_zeros(FormattedFloat0)
)
else
% Float will be represented in scientific notation.
% -------------------------------------------------
UncheckedFloat = change_to_e_notation(Float, Prec - 1, E),
% Do we need to remove trailing zeros?
( if Flags ^ flag_hash = flag_hash_set then
FormattedFloat = UncheckedFloat
else
split_at_exponent(UncheckedFloat, BaseStr, ExponentStr),
NewBaseStr = remove_trailing_zeros(BaseStr),
FormattedFloat = NewBaseStr ++ E ++ ExponentStr
)
).
% Convert floating point notation to scientific notation.
%
:- func change_to_e_notation(string, int, string) = string.
change_to_e_notation(Float, Prec, E) = ScientificFloat :-
UnsafeExponent = decimal_pos(Float),
UnsafeBase = calculate_base_unsafe(Float, Prec),
% Is mantissa greater than one digit long?
split_at_decimal_point(UnsafeBase, MantissaStr, _FractionStr),
( if string.count_code_points(MantissaStr) > 1 then
% Need to append 0, to fix the problem of having no numbers
% after the decimal point.
SafeBase = calculate_base_unsafe(string.append(UnsafeBase, "0"),
Prec),
SafeExponent = UnsafeExponent + 1
else
SafeBase = UnsafeBase,
SafeExponent = UnsafeExponent
),
% Creating exponent.
( if SafeExponent >= 0 then
( if SafeExponent < 10 then
ExponentStr = string.append_list(
[E, "+0", string.int_to_string(SafeExponent)])
else
ExponentStr = string.append_list(
[E, "+", string.int_to_string(SafeExponent)])
)
else
( if SafeExponent > -10 then
ExponentStr = string.append_list(
[E, "-0", string.int_to_string(int.abs(SafeExponent))])
else
ExponentStr = E ++ string.int_to_string(SafeExponent)
)
),
ScientificFloat = SafeBase ++ ExponentStr.
% Given a floating point number, this function calculates the size of
% the exponent needed to represent the float in scientific notation.
%
:- func size_of_required_exponent(string, int) = int.
size_of_required_exponent(Float, Prec) = Exponent :-
UnsafeExponent = decimal_pos(Float),
UnsafeBase = calculate_base_unsafe(Float, Prec),
% Is mantissa one digit long?
split_at_decimal_point(UnsafeBase, MantissaStr, _FractionStr),
( if string.count_code_points(MantissaStr) > 1 then
% We will need to move decimal pt one place to the left:
% therefore, increment exponent.
Exponent = UnsafeExponent + 1
else
Exponent = UnsafeExponent
).
% Given a string representing a floating point number, this function
% returns the string with all its trailing zeros removed.
%
:- func remove_trailing_zeros(string) = string.
remove_trailing_zeros(Float) = TrimmedFloat :-
FloatCharList = string.to_char_list(Float),
FloatCharListRev = list.reverse(FloatCharList),
TrimmedFloatRevCharList = remove_zeros(FloatCharListRev),
TrimmedFloatCharList = list.reverse(TrimmedFloatRevCharList),
TrimmedFloat = string.from_char_list(TrimmedFloatCharList).
% Given a char list, this function removes all leading zeros,
% including the decimal point, if need be.
%
:- func remove_zeros(list(char)) = list(char).
remove_zeros(CharNum) = TrimmedNum :-
( if CharNum = ['0' | Rest] then
TrimmedNum = remove_zeros(Rest)
else if CharNum = ['.' | Rest] then
TrimmedNum = Rest
else
TrimmedNum = CharNum
).
% Determine the location of the decimal point in a string
% that represents a floating point number.
%
:- func decimal_pos(string) = int.
decimal_pos(Float) = Pos :-
split_at_decimal_point(Float, MantissaStr, _FractionStr),
NumZeros = string.count_code_points(MantissaStr) - 1,
Pos = find_non_zero_pos(string.to_char_list(Float), NumZeros).
% Given a list of chars representing a floating point number, this
% function determines the first position containing a non-zero digit.
% Positions after the decimal point are negative, and those before the
% decimal point are positive.
%
:- func find_non_zero_pos(list(char), int) = int.
find_non_zero_pos(L, CurrentPos) = ActualPos :-
(
L = [H | T],
( if is_decimal_point(H) then
ActualPos = find_non_zero_pos(T, CurrentPos)
else if H = '0' then
ActualPos = find_non_zero_pos(T, CurrentPos - 1)
else
ActualPos = CurrentPos
)
;
L = [],
ActualPos = 0
).
% Representing a floating point number in scientific notation requires
% a base and an exponent. This function returns the base.
% But it is unsafe, because particular inputs can result in the base
% having a mantissa with more than one digit. Therefore, the calling
% function must check for this problem.
%
:- func calculate_base_unsafe(string, int) = string.
calculate_base_unsafe(Float, Prec) = Exp :-
Place = decimal_pos(Float),
split_at_decimal_point(Float, MantissaStr, FractionStr),
( if Place < 0 then
DecimalPos = abs(Place),
PaddedMantissaStr = string.between(FractionStr, 0, DecimalPos),
% Get rid of superfluous zeros.
MantissaInt = string.det_to_int(PaddedMantissaStr),
ExpMantissaStr = string.int_to_string(MantissaInt),
% Create fractional part.
PaddedFractionStr = pad_right(FractionStr, '0', Prec + 1),
ExpFractionStr = string.between(PaddedFractionStr, DecimalPos,
DecimalPos + Prec + 1)
else if Place > 0 then
ExpMantissaStr = string.between(MantissaStr, 0, 1),
FirstHalfOfFractionStr = string.between(MantissaStr, 1, Place + 1),
ExpFractionStr = FirstHalfOfFractionStr ++ FractionStr
else
ExpMantissaStr = MantissaStr,
ExpFractionStr = FractionStr
),
MantissaAndPoint = ExpMantissaStr ++ ".",
UnroundedExpStr = MantissaAndPoint ++ ExpFractionStr,
Exp = change_precision(UnroundedExpStr, Prec).
% Change the precision of a float to a specified number of decimal places.
%
% n.b. OldFloat must be positive for this function to work.
%
:- func change_precision(string, int) = string.
change_precision(OldFloat, Prec) = NewFloat :-
split_at_decimal_point(OldFloat, MantissaStr, FractionStr),
FracStrLen = string.count_code_points(FractionStr),
( if Prec > FracStrLen then
PrecFracStr = string.pad_right(FractionStr, '0', Prec),
PrecMantissaStr = MantissaStr
else if Prec < FracStrLen then
UnroundedFrac = string.between(FractionStr, 0, Prec),
NextDigit = string.det_index(FractionStr, Prec),
( if
UnroundedFrac \= "",
(char.to_int(NextDigit) - char.to_int('0')) >= 5
then
NewPrecFrac = string.det_to_int(UnroundedFrac) + 1,
NewPrecFracStrNotOK = string.int_to_string( NewPrecFrac),
NewPrecFracStr = string.pad_left(NewPrecFracStrNotOK, '0', Prec),
( if
string.count_code_points(NewPrecFracStr) >
string.count_code_points(UnroundedFrac)
then
PrecFracStr = between(NewPrecFracStr, 1, 1 + Prec),
PrecMantissaInt = det_to_int(MantissaStr) + 1,
PrecMantissaStr = int_to_string(PrecMantissaInt)
else
PrecFracStr = NewPrecFracStr,
PrecMantissaStr = MantissaStr
)
else if
UnroundedFrac = "",
(char.to_int(NextDigit) - char.to_int('0')) >= 5
then
PrecMantissaInt = det_to_int(MantissaStr) + 1,
PrecMantissaStr = int_to_string(PrecMantissaInt),
PrecFracStr = ""
else
PrecFracStr = UnroundedFrac,
PrecMantissaStr = MantissaStr
)
else
PrecFracStr = FractionStr,
PrecMantissaStr = MantissaStr
),
HalfNewFloat = PrecMantissaStr ++ ".",
NewFloat = HalfNewFloat ++ PrecFracStr.
:- pred split_at_exponent(string::in, string::out, string::out) is det.
split_at_exponent(Str, Float, Exponent) :-
FloatAndExponent = string.words_separator(is_exponent, Str),
list.det_index0(FloatAndExponent, 0, Float),
list.det_index0(FloatAndExponent, 1, Exponent).
:- pred split_at_decimal_point(string::in, string::out, string::out) is det.
split_at_decimal_point(Str, Mantissa, Fraction) :-
MantAndFrac = string.words_separator(is_decimal_point, Str),
list.det_index0(MantAndFrac, 0, Mantissa),
( if list.index0(MantAndFrac, 1, Fraction0) then
Fraction = Fraction0
else
Fraction = ""
).
:- pred is_decimal_point(char::in) is semidet.
is_decimal_point('.').
:- pred is_exponent(char::in) is semidet.
is_exponent('e').
is_exponent('E').
%---------------------------------------------------------------------------%
:- func sized_int_to_int(sized_int) = int.
sized_int_to_int(SizedInt) = Int :-
(
SizedInt = sized_int(Int)
;
SizedInt = sized_int8(Int8),
format_cast_int8_to_int(Int8, Int)
;
SizedInt = sized_int16(Int16),
format_cast_int16_to_int(Int16, Int)
;
SizedInt = sized_int32(Int32),
format_cast_int32_to_int(Int32, Int)
;
SizedInt = sized_int64(_),
throw(software_error("formatting int64 via a cast"))
).
:- func sized_int_to_uint(sized_int) = uint.
sized_int_to_uint(SizedInt) = UInt :-
(
SizedInt = sized_int(Int),
format_cast_int_to_uint(Int, UInt)
;
SizedInt = sized_int8(Int8),
format_cast_int8_to_uint(Int8, UInt)
;
SizedInt = sized_int16(Int16),
format_cast_int16_to_uint(Int16, UInt)
;
SizedInt = sized_int32(Int32),
format_cast_int32_to_uint(Int32, UInt)
;
SizedInt = sized_int64(_),
throw(software_error("formatting int64 via a cast"))
).
:- func sized_uint_to_uint(sized_uint) = uint.
sized_uint_to_uint(SizedUInt) = UInt :-
(
SizedUInt = sized_uint(UInt)
;
SizedUInt = sized_uint8(UInt8),
format_cast_uint8_to_uint(UInt8, UInt)
;
SizedUInt = sized_uint16(UInt16),
format_cast_uint16_to_uint(UInt16, UInt)
;
SizedUInt = sized_uint32(UInt32),
format_cast_uint32_to_uint(UInt32, UInt)
;
SizedUInt = sized_uint64(_),
throw(software_error("formatting uint64 via a cast"))
).
format_cast_int8_to_int(Int8, Int) :-
Int = int8.cast_to_int(Int8).
format_cast_int16_to_int(Int16, Int) :-
Int = int16.cast_to_int(Int16).
format_cast_int32_to_int(Int32, Int) :-
Int = int32.cast_to_int(Int32).
format_cast_int_to_uint(Int, UInt) :-
UInt = uint.cast_from_int(Int).
format_cast_int8_to_uint(Int8, UInt) :-
UInt = uint8.cast_to_uint(uint8.cast_from_int8(Int8)).
format_cast_int16_to_uint(Int16, UInt) :-
UInt = uint16.cast_to_uint(uint16.cast_from_int16(Int16)).
format_cast_int32_to_uint(Int32, UInt) :-
UInt = uint32.cast_to_uint(uint32.cast_from_int32(Int32)).
format_cast_uint8_to_uint(UInt8, UInt) :-
UInt = uint8.cast_to_uint(UInt8).
format_cast_uint16_to_uint(UInt16, UInt) :-
UInt = uint16.cast_to_uint(UInt16).
format_cast_uint32_to_uint(UInt32, UInt) :-
UInt = uint32.cast_to_uint(UInt32).
%---------------------------------------------------------------------------%
:- end_module string.format.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink