%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% %% %CopyrightEnd% %% -module(io_lib_format). %% Formatting functions of io library. -export([fwrite/2,fwrite/3,fwrite_g/1,indentation/2,scan/2,unscan/1, build/1, build/2]). %% Format the arguments in Args after string Format. Just generate %% an error if there is an error in the arguments. %% %% To do the printing command correctly we need to calculate the %% current indentation for everything before it. This may be very %% expensive, especially when it is not needed, so we first determine %% if, and for how long, we need to calculate the indentations. We do %% this by first collecting all the control sequences and %% corresponding arguments, then counting the print sequences and %% then building the output. This method has some drawbacks, it does %% two passes over the format string and creates more temporary data, %% and it also splits the handling of the control characters into two %% parts. -spec fwrite(Format, Data) -> io_lib:chars() when Format :: io:format(), Data :: [term()]. fwrite(Format, Args) -> build(scan(Format, Args)). -spec fwrite(Format, Data, Options) -> io_lib:chars() when Format :: io:format(), Data :: [term()], Options :: [Option], Option :: {'chars_limit', CharsLimit}, CharsLimit :: io_lib:chars_limit(). fwrite(Format, Args, Options) -> build(scan(Format, Args), Options). %% Build the output text for a pre-parsed format list. -spec build(FormatList) -> io_lib:chars() when FormatList :: [char() | io_lib:format_spec()]. build(Cs) -> build(Cs, []). -spec build(FormatList, Options) -> io_lib:chars() when FormatList :: [char() | io_lib:format_spec()], Options :: [Option], Option :: {'chars_limit', CharsLimit}, CharsLimit :: io_lib:chars_limit(). build(Cs, Options) -> CharsLimit = get_option(chars_limit, Options, -1), Res1 = build_small(Cs), {P, S, W, Other} = count_small(Res1), case P + S + W of 0 -> Res1; NumOfLimited -> RemainingChars = sub(CharsLimit, Other), build_limited(Res1, P, NumOfLimited, RemainingChars, 0) end. %% Parse all control sequences in the format string. -spec scan(Format, Data) -> FormatList when Format :: io:format(), Data :: [term()], FormatList :: [char() | io_lib:format_spec()]. scan(Format, Args) when is_atom(Format) -> scan(atom_to_list(Format), Args); scan(Format, Args) when is_binary(Format) -> scan(binary_to_list(Format), Args); scan(Format, Args) -> collect(Format, Args). %% Revert a pre-parsed format list to a plain character list and a %% list of arguments. -spec unscan(FormatList) -> {Format, Data} when FormatList :: [char() | io_lib:format_spec()], Format :: io:format(), Data :: [term()]. unscan(Cs) -> {print(Cs), args(Cs)}. args([#{args := As} | Cs]) -> As ++ args(Cs); args([_C | Cs]) -> args(Cs); args([]) -> []. print([#{control_char := C, width := F, adjust := Ad, precision := P, pad_char := Pad, encoding := Encoding, strings := Strings} | Cs]) -> print(C, F, Ad, P, Pad, Encoding, Strings) ++ print(Cs); print([C | Cs]) -> [C | print(Cs)]; print([]) -> []. print(C, F, Ad, P, Pad, Encoding, Strings) -> [$~] ++ print_field_width(F, Ad) ++ print_precision(P, Pad) ++ print_pad_char(Pad) ++ print_encoding(Encoding) ++ print_strings(Strings) ++ [C]. print_field_width(none, _Ad) -> ""; print_field_width(F, left) -> integer_to_list(-F); print_field_width(F, right) -> integer_to_list(F). print_precision(none, $\s) -> ""; print_precision(none, _Pad) -> "."; % pad must be second dot print_precision(P, _Pad) -> [$. | integer_to_list(P)]. print_pad_char($\s) -> ""; % default, no need to make explicit print_pad_char(Pad) -> [$., Pad]. print_encoding(unicode) -> "t"; print_encoding(latin1) -> "". print_strings(false) -> "l"; print_strings(true) -> "". collect([$~|Fmt0], Args0) -> {C,Fmt1,Args1} = collect_cseq(Fmt0, Args0), [C|collect(Fmt1, Args1)]; collect([C|Fmt], Args) -> [C|collect(Fmt, Args)]; collect([], []) -> []. collect_cseq(Fmt0, Args0) -> {F,Ad,Fmt1,Args1} = field_width(Fmt0, Args0), {P,Fmt2,Args2} = precision(Fmt1, Args1), {Pad,Fmt3,Args3} = pad_char(Fmt2, Args2), Spec0 = #{width => F, adjust => Ad, precision => P, pad_char => Pad, encoding => latin1, strings => true}, {Spec1,Fmt4} = modifiers(Fmt3, Spec0), {C,As,Fmt5,Args4} = collect_cc(Fmt4, Args3), Spec2 = Spec1#{control_char => C, args => As}, {Spec2,Fmt5,Args4}. modifiers([$t|Fmt], Spec) -> modifiers(Fmt, Spec#{encoding => unicode}); modifiers([$l|Fmt], Spec) -> modifiers(Fmt, Spec#{strings => false}); modifiers(Fmt, Spec) -> {Spec, Fmt}. field_width([$-|Fmt0], Args0) -> {F,Fmt,Args} = field_value(Fmt0, Args0), field_width(-F, Fmt, Args); field_width(Fmt0, Args0) -> {F,Fmt,Args} = field_value(Fmt0, Args0), field_width(F, Fmt, Args). field_width(F, Fmt, Args) when F < 0 -> {-F,left,Fmt,Args}; field_width(F, Fmt, Args) when F >= 0 -> {F,right,Fmt,Args}. precision([$.|Fmt], Args) -> field_value(Fmt, Args); precision(Fmt, Args) -> {none,Fmt,Args}. field_value([$*|Fmt], [A|Args]) when is_integer(A) -> {A,Fmt,Args}; field_value([C|Fmt], Args) when is_integer(C), C >= $0, C =< $9 -> field_value([C|Fmt], Args, 0); field_value(Fmt, Args) -> {none,Fmt,Args}. field_value([C|Fmt], Args, F) when is_integer(C), C >= $0, C =< $9 -> field_value(Fmt, Args, 10*F + (C - $0)); field_value(Fmt, Args, F) -> %Default case {F,Fmt,Args}. pad_char([$.,$*|Fmt], [Pad|Args]) -> {Pad,Fmt,Args}; pad_char([$.,Pad|Fmt], Args) -> {Pad,Fmt,Args}; pad_char(Fmt, Args) -> {$\s,Fmt,Args}. %% collect_cc([FormatChar], [Argument]) -> %% {Control,[ControlArg],[FormatChar],[Arg]}. %% Here we collect the argments for each control character. %% Be explicit to cause failure early. collect_cc([$w|Fmt], [A|Args]) -> {$w,[A],Fmt,Args}; collect_cc([$p|Fmt], [A|Args]) -> {$p,[A],Fmt,Args}; collect_cc([$W|Fmt], [A,Depth|Args]) -> {$W,[A,Depth],Fmt,Args}; collect_cc([$P|Fmt], [A,Depth|Args]) -> {$P,[A,Depth],Fmt,Args}; collect_cc([$s|Fmt], [A|Args]) -> {$s,[A],Fmt,Args}; collect_cc([$e|Fmt], [A|Args]) -> {$e,[A],Fmt,Args}; collect_cc([$f|Fmt], [A|Args]) -> {$f,[A],Fmt,Args}; collect_cc([$g|Fmt], [A|Args]) -> {$g,[A],Fmt,Args}; collect_cc([$b|Fmt], [A|Args]) -> {$b,[A],Fmt,Args}; collect_cc([$B|Fmt], [A|Args]) -> {$B,[A],Fmt,Args}; collect_cc([$x|Fmt], [A,Prefix|Args]) -> {$x,[A,Prefix],Fmt,Args}; collect_cc([$X|Fmt], [A,Prefix|Args]) -> {$X,[A,Prefix],Fmt,Args}; collect_cc([$+|Fmt], [A|Args]) -> {$+,[A],Fmt,Args}; collect_cc([$#|Fmt], [A|Args]) -> {$#,[A],Fmt,Args}; collect_cc([$c|Fmt], [A|Args]) -> {$c,[A],Fmt,Args}; collect_cc([$~|Fmt], Args) when is_list(Args) -> {$~,[],Fmt,Args}; collect_cc([$n|Fmt], Args) when is_list(Args) -> {$n,[],Fmt,Args}; collect_cc([$i|Fmt], [A|Args]) -> {$i,[A],Fmt,Args}. %% count_small([ControlC]) -> Count. %% Count the number of big (pPwWsS) print requests and %% number of characters of other print (small) requests. count_small(Cs) -> count_small(Cs, #{p => 0, s => 0, w => 0, other => 0}). count_small([#{control_char := $p}|Cs], #{p := P} = Cnts) -> count_small(Cs, Cnts#{p := P + 1}); count_small([#{control_char := $P}|Cs], #{p := P} = Cnts) -> count_small(Cs, Cnts#{p := P + 1}); count_small([#{control_char := $w}|Cs], #{w := W} = Cnts) -> count_small(Cs, Cnts#{w := W + 1}); count_small([#{control_char := $W}|Cs], #{w := W} = Cnts) -> count_small(Cs, Cnts#{w := W + 1}); count_small([#{control_char := $s}|Cs], #{w := W} = Cnts) -> count_small(Cs, Cnts#{w := W + 1}); count_small([S|Cs], #{other := Other} = Cnts) when is_list(S); is_binary(S) -> count_small(Cs, Cnts#{other := Other + io_lib:chars_length(S)}); count_small([C|Cs], #{other := Other} = Cnts) when is_integer(C) -> count_small(Cs, Cnts#{other := Other + 1}); count_small([], #{p := P, s := S, w := W, other := Other}) -> {P, S, W, Other}. %% build_small([Control]) -> io_lib:chars(). %% Interpret the control structures, but only the small ones. %% The big ones are saved for later. %% build_limited([Control], NumberOfPps, NumberOfLimited, %% CharsLimit, Indentation) %% Interpret the control structures. Count the number of print %% remaining and only calculate indentation when necessary. Must also %% be smart when calculating indentation for characters in format. build_small([#{control_char := C, args := As, width := F, adjust := Ad, precision := P, pad_char := Pad, encoding := Enc}=CC | Cs]) -> case control_small(C, As, F, Ad, P, Pad, Enc) of not_small -> [CC | build_small(Cs)]; S -> lists:flatten(S) ++ build_small(Cs) end; build_small([C|Cs]) -> [C|build_small(Cs)]; build_small([]) -> []. build_limited([#{control_char := C, args := As, width := F, adjust := Ad, precision := P, pad_char := Pad, encoding := Enc, strings := Str} | Cs], NumOfPs0, Count0, MaxLen0, I) -> MaxChars = if MaxLen0 < 0 -> MaxLen0; true -> MaxLen0 div Count0 end, S = control_limited(C, As, F, Ad, P, Pad, Enc, Str, MaxChars, I), NumOfPs = decr_pc(C, NumOfPs0), Count = Count0 - 1, MaxLen = if MaxLen0 < 0 -> % optimization MaxLen0; true -> Len = io_lib:chars_length(S), sub(MaxLen0, Len) end, if NumOfPs > 0 -> [S|build_limited(Cs, NumOfPs, Count, MaxLen, indentation(S, I))]; true -> [S|build_limited(Cs, NumOfPs, Count, MaxLen, I)] end; build_limited([$\n|Cs], NumOfPs, Count, MaxLen, _I) -> [$\n|build_limited(Cs, NumOfPs, Count, MaxLen, 0)]; build_limited([$\t|Cs], NumOfPs, Count, MaxLen, I) -> [$\t|build_limited(Cs, NumOfPs, Count, MaxLen, ((I + 8) div 8) * 8)]; build_limited([C|Cs], NumOfPs, Count, MaxLen, I) -> [C|build_limited(Cs, NumOfPs, Count, MaxLen, I+1)]; build_limited([], _, _, _, _) -> []. decr_pc($p, Pc) -> Pc - 1; decr_pc($P, Pc) -> Pc - 1; decr_pc(_, Pc) -> Pc. %% Calculate the indentation of the end of a string given its start %% indentation. We assume tabs at 8 cols. -spec indentation(String, StartIndent) -> integer() when String :: io_lib:chars(), StartIndent :: integer(). indentation([$\n|Cs], _I) -> indentation(Cs, 0); indentation([$\t|Cs], I) -> indentation(Cs, ((I + 8) div 8) * 8); indentation([C|Cs], I) when is_integer(C) -> indentation(Cs, I+1); indentation([C|Cs], I) -> indentation(Cs, indentation(C, I)); indentation([], I) -> I. %% control_small(FormatChar, [Argument], FieldWidth, Adjust, Precision, %% PadChar, Encoding) -> String %% control_limited(FormatChar, [Argument], FieldWidth, Adjust, Precision, %% PadChar, Encoding, StringP, ChrsLim, Indentation) -> String %% These are the dispatch functions for the various formatting controls. control_small($s, [A], F, Adj, P, Pad, latin1=Enc) when is_atom(A) -> L = iolist_to_chars(atom_to_list(A)), string(L, F, Adj, P, Pad, Enc); control_small($s, [A], F, Adj, P, Pad, unicode=Enc) when is_atom(A) -> string(atom_to_list(A), F, Adj, P, Pad, Enc); control_small($e, [A], F, Adj, P, Pad, _Enc) when is_float(A) -> fwrite_e(A, F, Adj, P, Pad); control_small($f, [A], F, Adj, P, Pad, _Enc) when is_float(A) -> fwrite_f(A, F, Adj, P, Pad); control_small($g, [A], F, Adj, P, Pad, _Enc) when is_float(A) -> fwrite_g(A, F, Adj, P, Pad); control_small($b, [A], F, Adj, P, Pad, _Enc) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, true); control_small($B, [A], F, Adj, P, Pad, _Enc) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, false); control_small($x, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true); control_small($x, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true); control_small($X, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false); control_small($X, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, false); control_small($+, [A], F, Adj, P, Pad, _Enc) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, true); control_small($#, [A], F, Adj, P, Pad, _Enc) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, false); control_small($c, [A], F, Adj, P, Pad, unicode) when is_integer(A) -> char(A, F, Adj, P, Pad); control_small($c, [A], F, Adj, P, Pad, _Enc) when is_integer(A) -> char(A band 255, F, Adj, P, Pad); control_small($~, [], F, Adj, P, Pad, _Enc) -> char($~, F, Adj, P, Pad); control_small($n, [], F, Adj, P, Pad, _Enc) -> newline(F, Adj, P, Pad); control_small($i, [_A], _F, _Adj, _P, _Pad, _Enc) -> []; control_small(_C, _As, _F, _Adj, _P, _Pad, _Enc) -> not_small. control_limited($s, [L0], F, Adj, P, Pad, latin1=Enc, _Str, CL, _I) -> L = iolist_to_chars(L0, F, CL), string(L, limit_field(F, CL), Adj, P, Pad, Enc); control_limited($s, [L0], F, Adj, P, Pad, unicode=Enc, _Str, CL, _I) -> L = cdata_to_chars(L0, F, CL), uniconv(string(L, limit_field(F, CL), Adj, P, Pad, Enc)); control_limited($w, [A], F, Adj, P, Pad, Enc, _Str, CL, _I) -> Chars = io_lib:write(A, [{depth, -1}, {encoding, Enc}, {chars_limit, CL}]), term(Chars, F, Adj, P, Pad); control_limited($p, [A], F, Adj, P, Pad, Enc, Str, CL, I) -> print(A, -1, F, Adj, P, Pad, Enc, Str, CL, I); control_limited($W, [A,Depth], F, Adj, P, Pad, Enc, _Str, CL, _I) when is_integer(Depth) -> Chars = io_lib:write(A, [{depth, Depth}, {encoding, Enc}, {chars_limit, CL}]), term(Chars, F, Adj, P, Pad); control_limited($P, [A,Depth], F, Adj, P, Pad, Enc, Str, CL, I) when is_integer(Depth) -> print(A, Depth, F, Adj, P, Pad, Enc, Str, CL, I). -ifdef(UNICODE_AS_BINARIES). uniconv(C) -> unicode:characters_to_binary(C,unicode). -else. uniconv(C) -> C. -endif. %% Default integer base base(none) -> 10; base(B) when is_integer(B) -> B. %% term(TermList, Field, Adjust, Precision, PadChar) %% Output the characters in a term. %% Adjust the characters within the field if length less than Max padding %% with PadChar. term(T, none, _Adj, none, _Pad) -> T; term(T, none, Adj, P, Pad) -> term(T, P, Adj, P, Pad); term(T, F, Adj, P0, Pad) -> L = io_lib:chars_length(T), P = erlang:min(L, case P0 of none -> F; _ -> min(P0, F) end), if L > P -> adjust(chars($*, P), chars(Pad, F-P), Adj); F >= P -> adjust(T, chars(Pad, F-L), Adj) end. %% print(Term, Depth, Field, Adjust, Precision, PadChar, Encoding, %% Indentation) %% Print a term. Field width sets maximum line length, Precision sets %% initial indentation. print(T, D, none, Adj, P, Pad, E, Str, ChLim, I) -> print(T, D, 80, Adj, P, Pad, E, Str, ChLim, I); print(T, D, F, Adj, none, Pad, E, Str, ChLim, I) -> print(T, D, F, Adj, I+1, Pad, E, Str, ChLim, I); print(T, D, F, right, P, _Pad, Enc, Str, ChLim, _I) -> Options = [{chars_limit, ChLim}, {column, P}, {line_length, F}, {depth, D}, {encoding, Enc}, {strings, Str}], io_lib_pretty:print(T, Options). %% fwrite_e(Float, Field, Adjust, Precision, PadChar) fwrite_e(Fl, none, Adj, none, Pad) -> %Default values fwrite_e(Fl, none, Adj, 6, Pad); fwrite_e(Fl, none, _Adj, P, _Pad) when P >= 2 -> float_e(Fl, float_data(Fl), P); fwrite_e(Fl, F, Adj, none, Pad) -> fwrite_e(Fl, F, Adj, 6, Pad); fwrite_e(Fl, F, Adj, P, Pad) when P >= 2 -> term(float_e(Fl, float_data(Fl), P), F, Adj, F, Pad). float_e(Fl, Fd, P) when Fl < 0.0 -> %Negative numbers [$-|float_e(-Fl, Fd, P)]; float_e(_Fl, {Ds,E}, P) -> case float_man(Ds, 1, P-1) of {[$0|Fs],true} -> [[$1|Fs]|float_exp(E)]; {Fs,false} -> [Fs|float_exp(E-1)] end. %% float_man([Digit], Icount, Dcount) -> {[Char],CarryFlag}. %% Generate the characters in the mantissa from the digits with Icount %% characters before the '.' and Dcount decimals. Handle carry and let %% caller decide what to do at top. float_man(Ds, 0, Dc) -> {Cs,C} = float_man(Ds, Dc), {[$.|Cs],C}; float_man([D|Ds], I, Dc) -> case float_man(Ds, I-1, Dc) of {Cs,true} when D =:= $9 -> {[$0|Cs],true}; {Cs,true} -> {[D+1|Cs],false}; {Cs,false} -> {[D|Cs],false} end; float_man([], I, Dc) -> %Pad with 0's {lists:duplicate(I, $0) ++ [$.|lists:duplicate(Dc, $0)],false}. float_man([D|_], 0) when D >= $5 -> {[],true}; float_man([_|_], 0) -> {[],false}; float_man([D|Ds], Dc) -> case float_man(Ds, Dc-1) of {Cs,true} when D =:= $9 -> {[$0|Cs],true}; {Cs,true} -> {[D+1|Cs],false}; {Cs,false} -> {[D|Cs],false} end; float_man([], Dc) -> {lists:duplicate(Dc, $0),false}. %Pad with 0's %% float_exp(Exponent) -> [Char]. %% Generate the exponent of a floating point number. Always include sign. float_exp(E) when E >= 0 -> [$e,$+|integer_to_list(E)]; float_exp(E) -> [$e|integer_to_list(E)]. %% fwrite_f(FloatData, Field, Adjust, Precision, PadChar) fwrite_f(Fl, none, Adj, none, Pad) -> %Default values fwrite_f(Fl, none, Adj, 6, Pad); fwrite_f(Fl, none, _Adj, P, _Pad) when P >= 1 -> float_f(Fl, float_data(Fl), P); fwrite_f(Fl, F, Adj, none, Pad) -> fwrite_f(Fl, F, Adj, 6, Pad); fwrite_f(Fl, F, Adj, P, Pad) when P >= 1 -> term(float_f(Fl, float_data(Fl), P), F, Adj, F, Pad). float_f(Fl, Fd, P) when Fl < 0.0 -> [$-|float_f(-Fl, Fd, P)]; float_f(Fl, {Ds,E}, P) when E =< 0 -> float_f(Fl, {lists:duplicate(-E+1, $0)++Ds,1}, P); %Prepend enough 0's float_f(_Fl, {Ds,E}, P) -> case float_man(Ds, E, P) of {Fs,true} -> "1" ++ Fs; %Handle carry {Fs,false} -> Fs end. %% float_data([FloatChar]) -> {[Digit],Exponent} float_data(Fl) -> float_data(float_to_list(Fl), []). float_data([$e|E], Ds) -> {lists:reverse(Ds),list_to_integer(E)+1}; float_data([D|Cs], Ds) when D >= $0, D =< $9 -> float_data(Cs, [D|Ds]); float_data([_|Cs], Ds) -> float_data(Cs, Ds). %% Writes the shortest, correctly rounded string that converts %% to Float when read back with list_to_float/1. %% %% See also "Printing Floating-Point Numbers Quickly and Accurately" %% in Proceedings of the SIGPLAN '96 Conference on Programming %% Language Design and Implementation. -spec fwrite_g(float()) -> string(). fwrite_g(0.0) -> "0.0"; fwrite_g(Float) when is_float(Float) -> {Frac, Exp} = mantissa_exponent(Float), {Place, Digits} = fwrite_g_1(Float, Exp, Frac), R = insert_decimal(Place, [$0 + D || D <- Digits]), [$- || true <- [Float < 0.0]] ++ R. -define(BIG_POW, (1 bsl 52)). -define(MIN_EXP, (-1074)). mantissa_exponent(F) -> case <> of <<_S:1, 0:11, M:52>> -> % denormalized E = log2floor(M), {M bsl (53 - E), E - 52 - 1075}; <<_S:1, BE:11, M:52>> when BE < 2047 -> {M + ?BIG_POW, BE - 1075} end. fwrite_g_1(Float, Exp, Frac) -> Round = (Frac band 1) =:= 0, if Exp >= 0 -> BExp = 1 bsl Exp, if Frac =:= ?BIG_POW -> scale(Frac * BExp * 4, 4, BExp * 2, BExp, Round, Round, Float); true -> scale(Frac * BExp * 2, 2, BExp, BExp, Round, Round, Float) end; Exp < ?MIN_EXP -> BExp = 1 bsl (?MIN_EXP - Exp), scale(Frac * 2, 1 bsl (1 - Exp), BExp, BExp, Round, Round, Float); Exp > ?MIN_EXP, Frac =:= ?BIG_POW -> scale(Frac * 4, 1 bsl (2 - Exp), 2, 1, Round, Round, Float); true -> scale(Frac * 2, 1 bsl (1 - Exp), 1, 1, Round, Round, Float) end. scale(R, S, MPlus, MMinus, LowOk, HighOk, Float) -> Est = int_ceil(math:log10(abs(Float)) - 1.0e-10), %% Note that the scheme implementation uses a 326 element look-up %% table for int_pow(10, N) where we do not. if Est >= 0 -> fixup(R, S * int_pow(10, Est), MPlus, MMinus, Est, LowOk, HighOk); true -> Scale = int_pow(10, -Est), fixup(R * Scale, S, MPlus * Scale, MMinus * Scale, Est, LowOk, HighOk) end. fixup(R, S, MPlus, MMinus, K, LowOk, HighOk) -> TooLow = if HighOk -> R + MPlus >= S; true -> R + MPlus > S end, case TooLow of true -> {K + 1, generate(R, S, MPlus, MMinus, LowOk, HighOk)}; false -> {K, generate(R * 10, S, MPlus * 10, MMinus * 10, LowOk, HighOk)} end. generate(R0, S, MPlus, MMinus, LowOk, HighOk) -> D = R0 div S, R = R0 rem S, TC1 = if LowOk -> R =< MMinus; true -> R < MMinus end, TC2 = if HighOk -> R + MPlus >= S; true -> R + MPlus > S end, case {TC1, TC2} of {false, false} -> [D | generate(R * 10, S, MPlus * 10, MMinus * 10, LowOk, HighOk)]; {false, true} -> [D + 1]; {true, false} -> [D]; {true, true} when R * 2 < S -> [D]; {true, true} -> [D + 1] end. insert_decimal(0, S) -> "0." ++ S; insert_decimal(Place, S) -> L = length(S), if Place < 0; Place >= L -> ExpL = integer_to_list(Place - 1), ExpDot = if L =:= 1 -> 2; true -> 1 end, ExpCost = length(ExpL) + 1 + ExpDot, if Place < 0 -> if 2 - Place =< ExpCost -> "0." ++ lists:duplicate(-Place, $0) ++ S; true -> insert_exp(ExpL, S) end; true -> if Place - L + 2 =< ExpCost -> S ++ lists:duplicate(Place - L, $0) ++ ".0"; true -> insert_exp(ExpL, S) end end; true -> {S0, S1} = lists:split(Place, S), S0 ++ "." ++ S1 end. insert_exp(ExpL, [C]) -> [C] ++ ".0e" ++ ExpL; insert_exp(ExpL, [C | S]) -> [C] ++ "." ++ S ++ "e" ++ ExpL. int_ceil(X) when is_float(X) -> T = trunc(X), case (X - T) of Neg when Neg < 0 -> T; Pos when Pos > 0 -> T + 1; _ -> T end. int_pow(X, 0) when is_integer(X) -> 1; int_pow(X, N) when is_integer(X), is_integer(N), N > 0 -> int_pow(X, N, 1). int_pow(X, N, R) when N < 2 -> R * X; int_pow(X, N, R) -> int_pow(X * X, N bsr 1, case N band 1 of 1 -> R * X; 0 -> R end). log2floor(Int) when is_integer(Int), Int > 0 -> log2floor(Int, 0). log2floor(0, N) -> N; log2floor(Int, N) -> log2floor(Int bsr 1, 1 + N). %% fwrite_g(Float, Field, Adjust, Precision, PadChar) %% Use the f form if Float is >= 0.1 and < 1.0e4, %% and the prints correctly in the f form, else the e form. %% Precision always means the # of significant digits. fwrite_g(Fl, F, Adj, none, Pad) -> fwrite_g(Fl, F, Adj, 6, Pad); fwrite_g(Fl, F, Adj, P, Pad) when P >= 1 -> A = abs(Fl), E = if A < 1.0e-1 -> -2; A < 1.0e0 -> -1; A < 1.0e1 -> 0; A < 1.0e2 -> 1; A < 1.0e3 -> 2; A < 1.0e4 -> 3; true -> fwrite_f end, if P =< 1, E =:= -1; P-1 > E, E >= -1 -> fwrite_f(Fl, F, Adj, P-1-E, Pad); P =< 1 -> fwrite_e(Fl, F, Adj, 2, Pad); true -> fwrite_e(Fl, F, Adj, P, Pad) end. iolist_to_chars(Cs, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> iolist_to_chars(Cs); iolist_to_chars(Cs, _, CharsLimit) -> limit_iolist_to_chars(Cs, sub(CharsLimit, 3), [], normal). % three dots iolist_to_chars([C|Cs]) when is_integer(C), C >= $\000, C =< $\377 -> [C | iolist_to_chars(Cs)]; iolist_to_chars([I|Cs]) -> [iolist_to_chars(I) | iolist_to_chars(Cs)]; iolist_to_chars([]) -> []; iolist_to_chars(B) when is_binary(B) -> binary_to_list(B). limit_iolist_to_chars(Cs, 0, S, normal) -> L = limit_iolist_to_chars(Cs, 4, S, final), case iolist_size(L) of N when N < 4 -> L; 4 -> "..." end; limit_iolist_to_chars(_Cs, 0, _S, final) -> []; limit_iolist_to_chars([C|Cs], Limit, S, Mode) when C >= $\000, C =< $\377 -> [C | limit_iolist_to_chars(Cs, Limit - 1, S, Mode)]; limit_iolist_to_chars([I|Cs], Limit, S, Mode) -> limit_iolist_to_chars(I, Limit, [Cs|S], Mode); limit_iolist_to_chars([], _Limit, [], _Mode) -> []; limit_iolist_to_chars([], Limit, [Cs|S], Mode) -> limit_iolist_to_chars(Cs, Limit, S, Mode); limit_iolist_to_chars(B, Limit, S, Mode) when is_binary(B) -> case byte_size(B) of Sz when Sz > Limit -> {B1, B2} = split_binary(B, Limit), [binary_to_list(B1) | limit_iolist_to_chars(B2, 0, S, Mode)]; Sz -> [binary_to_list(B) | limit_iolist_to_chars([], Limit-Sz, S, Mode)] end. cdata_to_chars(Cs, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> cdata_to_chars(Cs); cdata_to_chars(Cs, _, CharsLimit) -> limit_cdata_to_chars(Cs, sub(CharsLimit, 3), normal). % three dots cdata_to_chars([C|Cs]) when is_integer(C), C >= $\000 -> [C | cdata_to_chars(Cs)]; cdata_to_chars([I|Cs]) -> [cdata_to_chars(I) | cdata_to_chars(Cs)]; cdata_to_chars([]) -> []; cdata_to_chars(B) when is_binary(B) -> case catch unicode:characters_to_list(B) of L when is_list(L) -> L; _ -> binary_to_list(B) end. limit_cdata_to_chars(Cs, 0, normal) -> L = limit_cdata_to_chars(Cs, 4, final), case string:length(L) of N when N < 4 -> L; 4 -> "..." end; limit_cdata_to_chars(_Cs, 0, final) -> []; limit_cdata_to_chars(Cs, Limit, Mode) -> case string:next_grapheme(Cs) of {error, <>} -> %% This is how ~ts handles Latin1 binaries with option %% chars_limit. [C | limit_cdata_to_chars(Cs1, Limit - 1, Mode)]; {error, [C|Cs1]} -> % not all versions of module string return this [C | limit_cdata_to_chars(Cs1, Limit - 1, Mode)]; [] -> []; [GC|Cs1] -> [GC | limit_cdata_to_chars(Cs1, Limit - 1, Mode)] end. limit_field(F, CharsLimit) when CharsLimit < 0; F =:= none -> F; limit_field(F, CharsLimit) -> max(3, min(F, CharsLimit)). %% string(String, Field, Adjust, Precision, PadChar) string(S, none, _Adj, none, _Pad, _Enc) -> S; string(S, F, Adj, none, Pad, Enc) -> string_field(S, F, Adj, io_lib:chars_length(S), Pad, Enc); string(S, none, _Adj, P, Pad, Enc) -> string_field(S, P, left, io_lib:chars_length(S), Pad, Enc); string(S, F, Adj, P, Pad, Enc) when F >= P -> N = io_lib:chars_length(S), if F > P -> if N > P -> adjust(flat_trunc(S, P, Enc), chars(Pad, F-P), Adj); N < P -> adjust([S|chars(Pad, P-N)], chars(Pad, F-P), Adj); true -> % N == P adjust(S, chars(Pad, F-P), Adj) end; true -> % F == P string_field(S, F, Adj, N, Pad, Enc) end. string_field(S, F, _Adj, N, _Pad, Enc) when N > F -> flat_trunc(S, F, Enc); string_field(S, F, Adj, N, Pad, _Enc) when N < F -> adjust(S, chars(Pad, F-N), Adj); string_field(S, _, _, _, _, _) -> % N == F S. %% unprefixed_integer(Int, Field, Adjust, Base, PadChar, Lowercase) %% -> [Char]. unprefixed_integer(Int, F, Adj, Base, Pad, Lowercase) when Base >= 2, Base =< 1+$Z-$A+10 -> if Int < 0 -> S = cond_lowercase(erlang:integer_to_list(-Int, Base), Lowercase), term([$-|S], F, Adj, none, Pad); true -> S = cond_lowercase(erlang:integer_to_list(Int, Base), Lowercase), term(S, F, Adj, none, Pad) end. %% prefixed_integer(Int, Field, Adjust, Base, PadChar, Prefix, Lowercase) %% -> [Char]. prefixed_integer(Int, F, Adj, Base, Pad, Prefix, Lowercase) when Base >= 2, Base =< 1+$Z-$A+10 -> if Int < 0 -> S = cond_lowercase(erlang:integer_to_list(-Int, Base), Lowercase), term([$-,Prefix|S], F, Adj, none, Pad); true -> S = cond_lowercase(erlang:integer_to_list(Int, Base), Lowercase), term([Prefix|S], F, Adj, none, Pad) end. %% char(Char, Field, Adjust, Precision, PadChar) -> chars(). char(C, none, _Adj, none, _Pad) -> [C]; char(C, F, _Adj, none, _Pad) -> chars(C, F); char(C, none, _Adj, P, _Pad) -> chars(C, P); char(C, F, Adj, P, Pad) when F >= P -> adjust(chars(C, P), chars(Pad, F - P), Adj). %% newline(Field, Adjust, Precision, PadChar) -> [Char]. newline(none, _Adj, _P, _Pad) -> "\n"; newline(F, right, _P, _Pad) -> chars($\n, F). %% %% Utilities %% adjust(Data, [], _) -> Data; adjust(Data, Pad, left) -> [Data|Pad]; adjust(Data, Pad, right) -> [Pad|Data]. %% Flatten and truncate a deep list to at most N elements. flat_trunc(List, N, latin1) when is_integer(N), N >= 0 -> {S, _} = lists:split(N, lists:flatten(List)), S; flat_trunc(List, N, unicode) when is_integer(N), N >= 0 -> string:slice(List, 0, N). %% A deep version of lists:duplicate/2 chars(_C, 0) -> []; chars(C, 1) -> [C]; chars(C, 2) -> [C,C]; chars(C, 3) -> [C,C,C]; chars(C, N) when is_integer(N), (N band 1) =:= 0 -> S = chars(C, N bsr 1), [S|S]; chars(C, N) when is_integer(N) -> S = chars(C, N bsr 1), [C,S|S]. %chars(C, N, Tail) -> % [chars(C, N)|Tail]. %% Lowercase conversion cond_lowercase(String, true) -> lowercase(String); cond_lowercase(String,false) -> String. lowercase([H|T]) when is_integer(H), H >= $A, H =< $Z -> [(H-$A+$a)|lowercase(T)]; lowercase([H|T]) -> [H|lowercase(T)]; lowercase([]) -> []. %% Make sure T does change sign. sub(T, _) when T < 0 -> T; sub(T, E) when T >= E -> T - E; sub(_, _) -> 0. get_option(Key, TupleList, Default) -> case lists:keyfind(Key, 1, TupleList) of false -> Default; {Key, Value} -> Value; _ -> Default end.