From 78ad7a2500e4295af47e1770ac74cb8b7ce12cfd Mon Sep 17 00:00:00 2001 From: SisMaker <1713699517@qq.com> Date: Sat, 20 Feb 2021 15:42:37 +0800 Subject: [PATCH] =?UTF-8?q?ft:=20=E4=BF=AE=E6=94=B9=E4=B8=BA=E4=BA=8C?= =?UTF-8?q?=E8=BF=9B=E5=88=B6=E5=8C=B9=E9=85=8D?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/eFmt.erl | 274 ++++++++++++---------------------- src/eFmtFormat.erl | 360 +++------------------------------------------ 2 files changed, 114 insertions(+), 520 deletions(-) diff --git a/src/eFmt.erl b/src/eFmt.erl index b3f88ae..7c6be55 100644 --- a/src/eFmt.erl +++ b/src/eFmt.erl @@ -19,13 +19,12 @@ , write/1 , write/2 , write/3 + , doWrite/4 , format_prompt/1 , format_prompt/2 - , write_binary/3 - - , write_atom/1 + , writeAtom/2 , write_string/1 , write_string/2 , write_latin1_string/1 @@ -33,13 +32,11 @@ , write_char/1 , write_latin1_char/1 - , write_atom_as_latin1/1 , write_string_as_latin1/1 , write_string_as_latin1/2 , write_char_as_latin1/1 - , quote_atom/2 , char_list/1 , latin1_char_list/1 , deep_char_list/1 @@ -73,8 +70,6 @@ , latin1_string/0 , continuation/0 , fread_error/0 - , fread_item/0 - , format_spec/0 , fmtSpec/0 , chars_limit/0 ]). @@ -101,26 +96,8 @@ | 'string' | 'unsigned'. --type fread_item() :: -string() | -atom() | -integer() | -float(). - -type fmtSpec() :: #fmtSpec{}. --type format_spec() :: -#{ -control_char := char(), -args := [any()], -width := 'none' | integer(), -adjust := 'left' | 'right', -precision := 'none' | integer(), -pad_char := char(), -encoding := 'unicode' | 'latin1', -strings := boolean() -}. - %%---------------------------------------------------------------------- -spec format(Format :: io:format(), Data :: [term()]) -> chars(). format(Format, Args) -> @@ -143,7 +120,7 @@ format(Format, Args, Options) -> -spec scan_format(Format, Data) -> FormatList when Format :: io:format(), Data :: [term()], - FormatList :: [char() | format_spec()]. + FormatList :: [char() | fmtSpec()]. scan_format(Format, Args) -> try eFmtFormat:scan(Format, Args) @@ -154,7 +131,7 @@ scan_format(Format, Args) -> end. -spec unscan_format(FormatList) -> {Format, Data} when - FormatList :: [char() | format_spec()], + FormatList :: [char() | fmtSpec()], Format :: io:format(), Data :: [term()]. @@ -162,7 +139,7 @@ unscan_format(FormatList) -> eFmtFormat:unscan(FormatList). -spec build_text(FormatList) -> chars() when - FormatList :: [char() | format_spec()]. + FormatList :: [char() | fmtSpec()]. build_text(FormatList) -> try eFmtFormat:build(FormatList) @@ -173,7 +150,7 @@ build_text(FormatList) -> end. -spec build_text(FormatList, Options) -> chars() when - FormatList :: [char() | format_spec()], + FormatList :: [char() | fmtSpec()], Options :: [Option], Option :: {'chars_limit', CharsLimit}, CharsLimit :: chars_limit(). @@ -260,7 +237,7 @@ add_modifier(_, C) -> Term :: term(). write(Term) -> - write1(Term, -1, latin1). + writeTerm(Term, -1, latin1). -spec write(term(), depth(), boolean()) -> chars(). @@ -289,7 +266,7 @@ write(Term, Options) when is_list(Options) -> Depth =:= 0; CharsLimit =:= 0 -> "..."; CharsLimit < 0 -> - write1(Term, Depth, Encoding); + writeTerm(Term, Depth, Encoding); CharsLimit > 0 -> RecDefFun = fun(_, _) -> no end, If = io_lib_pretty:intermediate(Term, Depth, CharsLimit, RecDefFun, Encoding, _Str = false), @@ -298,177 +275,114 @@ write(Term, Options) when is_list(Options) -> write(Term, Depth) -> write(Term, [{depth, Depth}, {encoding, latin1}]). -write1(_Term, 0, _E) -> "..."; -write1(Term, _D, _E) when is_integer(Term) -> integer_to_list(Term); -write1(Term, _D, _E) when is_float(Term) -> eFmtFormat:fwrite_g(Term); -write1(Atom, _D, latin1) when is_atom(Atom) -> write_atom_as_latin1(Atom); -write1(Atom, _D, _E) when is_atom(Atom) -> write_atom(Atom); -write1(Term, _D, _E) when is_port(Term) -> write_port(Term); -write1(Term, _D, _E) when is_pid(Term) -> pid_to_list(Term); -write1(Term, _D, _E) when is_reference(Term) -> write_ref(Term); -write1(<<_/bitstring>> = Term, D, _E) -> write_binary(Term, D); -write1([], _D, _E) -> "[]"; -write1({}, _D, _E) -> "{}"; -write1([H | T], D, E) -> - if - D =:= 1 -> "[...]"; - true -> - [$[, [write1(H, D - 1, E) | write_tail(T, D - 1, E)], $]] - end; -write1(F, _D, _E) when is_function(F) -> - erlang:fun_to_list(F); -write1(Term, D, E) when is_map(Term) -> - write_map(Term, D, E); -write1(T, D, E) when is_tuple(T) -> + + +doWrite(Term, Depth, Encoding, CharsLimit) -> if - D =:= 1 -> "{...}"; + Depth =:= 0 orelse CharsLimit =:= 0 -> + <<"...">>; + CharsLimit < 0 -> + writeTerm(Term, Depth, Encoding); true -> - [${, - [write1(element(1, T), D - 1, E) | write_tuple(T, 2, D - 1, E)], - $}] + RecDefFun = fun(_, _) -> no end, + If = io_lib_pretty:intermediate(Term, Depth, CharsLimit, RecDefFun, Encoding, _Str = false), + io_lib_pretty:write(If) end. -%% write_tail(List, Depth, Encoding) -%% Test the terminating case first as this looks better with depth. +-define(writeInt(Int), integer_to_binary(Term)). -write_tail([], _D, _E) -> ""; -write_tail(_, 1, _E) -> [$| | "..."]; -write_tail([H | T], D, E) -> - [$,, write1(H, D - 1, E) | write_tail(T, D - 1, E)]; -write_tail(Other, D, E) -> - [$|, write1(Other, D - 1, E)]. +-define(writeFloat(Float), eFmtFormat:floatG(Term)). -write_tuple(T, I, _D, _E) when I > tuple_size(T) -> ""; -write_tuple(_, _I, 1, _E) -> [$, | "..."]; -write_tuple(T, I, D, E) -> - [$,, write1(element(I, T), D - 1, E) | write_tuple(T, I + 1, D - 1, E)]. +-define(writeAtom(Atom, Encoding), <<"'", (atom_to_binary(Atom, Encoding))/binary, "'">>). -write_port(Port) -> - erlang:port_to_list(Port). +-define(writePort(Port), list_to_binary(erlang:port_to_list(Port))). -write_ref(Ref) -> - erlang:ref_to_list(Ref). +-define(writeRef(Ref), list_to_binary(erlang:ref_to_list(Ref))). -write_map(_, 1, _E) -> "#{}"; -write_map(Map, D, E) when is_integer(D) -> - I = maps:iterator(Map), - case maps:next(I) of - {K, V, NextI} -> - D0 = D - 1, - W = write_map_assoc(K, V, D0, E), - [$#, ${, [W | write_map_body(NextI, D0, D0, E)], $}]; - none -> "#{}" - end. +-define(writePid(Ref), list_to_binary(erlang:pid_to_list(Ref))). -write_map_body(_, 1, _D0, _E) -> ",..."; -write_map_body(I, D, D0, E) -> - case maps:next(I) of - {K, V, NextI} -> - W = write_map_assoc(K, V, D0, E), - [$,, W | write_map_body(NextI, D - 1, D0, E)]; - none -> "" - end. +-define(writeFun(Fun), list_to_binary(erlang:fun_to_list(Fun))). -write_map_assoc(K, V, D, E) -> - [write1(K, D, E), " => ", write1(V, D, E)]. - -write_binary(B, D) when is_integer(D) -> - {S, _} = write_binary(B, D, -1), - S. - -write_binary(B, D, T) -> - {S, Rest} = write_binary_body(B, D, tsub(T, 4), []), - {[$<, $<, lists:reverse(S), $>, $>], Rest}. - -write_binary_body(<<>> = B, _D, _T, Acc) -> - {Acc, B}; -write_binary_body(B, D, T, Acc) when D =:= 1; T =:= 0 -> - {["..." | Acc], B}; -write_binary_body(<>, _D, _T, Acc) -> - {[integer_to_list(X) | Acc], <<>>}; -write_binary_body(<>, D, T, Acc) -> - S = integer_to_list(X), - write_binary_body(Rest, D - 1, tsub(T, length(S) + 1), [$,, S | Acc]); -write_binary_body(B, _D, _T, Acc) -> - L = bit_size(B), - <> = B, - {[integer_to_list(L), $:, integer_to_list(X) | Acc], <<>>}. - -%% Make sure T does not change sign. -tsub(T, _) when T < 0 -> T; -tsub(T, E) when T >= E -> T - E; -tsub(_, _) -> 0. +writeTerm(_Term, 0, _E) -> <<"...">>; +writeTerm(Term, _D, _E) when is_integer(Term) -> ?writeInt(Term); +writeTerm(Term, _D, _E) when is_float(Term) -> ?writeFloat(Term); +writeTerm(Atom, _D, E) when is_atom(Atom) -> ?writeAtom(Atom, E); +writeTerm(Term, _D, _E) when is_port(Term) -> ?writePort(Term); +writeTerm(Term, _D, _E) when is_pid(Term) -> ?writePid(Term); +writeTerm(Term, _D, _E) when is_reference(Term) -> ?writeRef(Term); +writeTerm(Term, _D, _E) when is_function(Term) -> ?writeFun(Term); +writeTerm(Term, D, _E) when is_binary(Term) -> writeBinary(Term, D); +writeTerm(Term, D, _E) when is_bitstring(Term) -> writeBinary(Term, D); +writeTerm(Term, D, E) when is_list(Term) -> writeList(Term, D, E, <<"[">>); +writeTerm(Term, D, E) when is_map(Term) -> writeMap(Term, D, E, <<"#{">>); +writeTerm(Term, D, E) when is_tuple(Term) -> writeTuple(Term, D, E, 1, tuple_size(Term), <<"{">>). -get_option(Key, TupleList, Default) -> - case lists:keyfind(Key, 1, TupleList) of - false -> Default; - {Key, Value} -> Value; - _ -> Default - end. +writeAtom(Atom, Encoding) -> + <<"'", (atom_to_binary(Atom, Encoding))/binary, "'">>. -%%% There are two functions to write Unicode atoms: -%%% - they both escape control characters < 160; -%%% - write_atom() never escapes characters >= 160; -%%% - write_atom_as_latin1() also escapes characters >= 255. - -%% write_atom(Atom) -> [Char] -%% Generate the list of characters needed to print an atom. - --spec write_atom(Atom) -> chars() when - Atom :: atom(). +writeList([], _D, _E, BinAcc) -> + <>; +writeList([One], D, E, BinAcc) -> + <>; +writeList([One | List], D, E, BinAcc) -> + if + D =:= 1 -> <>; + true -> + writeList(List, D - 1, E, <>) + end; +writeList(Other, D, E, BinAcc) -> + <>. -write_atom(Atom) -> - write_possibly_quoted_atom(Atom, fun write_string/2). +writeTuple(Tuple, D, E, Index, TupleSize, BinAcc) -> + if + D =:= 1 -> <>; + true -> + if + Index < TupleSize -> + writeTuple(Tuple, D - 1, E, Index + 1, TupleSize, <>); + Index == TupleSize -> + <>; + true -> + <> + end + end. --spec write_atom_as_latin1(Atom) -> latin1_string() when - Atom :: atom(). +writeMap(Map, D, E, BinAcc) when is_integer(D) -> + if + D =:= 1 -> + <>; + true -> + writeMapBody(maps:iterator(Map), D, E, BinAcc) + end. -write_atom_as_latin1(Atom) -> - write_possibly_quoted_atom(Atom, fun write_string_as_latin1/2). +writeMapBody(I, D, E, BinAcc) -> + if + D =:= 1 -> + <>; + true -> + case maps:next(I) of + {K, V, NextI} -> + writeMapBody(NextI, D - 1, E, < ", (writeTerm(V, D, E))/binary>>); + none -> + <> + end + end. -write_possibly_quoted_atom(Atom, PFun) -> - Chars = atom_to_list(Atom), - case quote_atom(Atom, Chars) of +writeBinary(Bin, D) -> + if + D == 1 -> + <<"...">>; true -> - PFun(Chars, $'); %' - false -> - Chars + <<"<<", Bin/binary, ">>">> end. -%% quote_atom(Atom, CharList) -%% Return 'true' if atom with chars in CharList needs to be quoted, else -%% return 'false'. Notice that characters >= 160 are always quoted. - --spec quote_atom(atom(), chars()) -> boolean(). - -quote_atom(Atom, Cs0) -> - case erl_scan:reserved_word(Atom) of - true -> true; - false -> - case Cs0 of - [C | Cs] when C >= $a, C =< $z -> - not name_chars(Cs); - [C | Cs] when C >= $ß, C =< $ÿ, C =/= $÷ -> - not name_chars(Cs); - _ -> true - end +get_option(Key, TupleList, Default) -> + case lists:keyfind(Key, 1, TupleList) of + false -> Default; + {Key, Value} -> Value; + _ -> Default end. -name_chars([C | Cs]) -> - case name_char(C) of - true -> name_chars(Cs); - false -> false - end; -name_chars([]) -> true. - -name_char(C) when C >= $a, C =< $z -> true; -name_char(C) when C >= $ß, C =< $ÿ, C =/= $÷ -> true; -name_char(C) when C >= $A, C =< $Z -> true; -name_char(C) when C >= $À, C =< $Þ, C =/= $× -> true; -name_char(C) when C >= $0, C =< $9 -> true; -name_char($_) -> true; -name_char($@) -> true; -name_char(_) -> false. %%% There are two functions to write Unicode strings: %%% - they both escape control characters < 160; diff --git a/src/eFmtFormat.erl b/src/eFmtFormat.erl index d7ea884..c880884 100644 --- a/src/eFmtFormat.erl +++ b/src/eFmtFormat.erl @@ -8,10 +8,8 @@ -export([ fwrite/2 , fwrite/3 - , fwrite_g/1 - , indentation/2 + , floatG/1 , scan/2 - , unscan/1 , build/1 , build/2 ]). @@ -215,9 +213,9 @@ buildSmall([OneCA | Cs], Acc) -> ctlSmall($s, Args, Width, Adjust, Precision, PadChar, Encoding) when is_atom(Args) -> case Encoding of latin1 -> - AtomBinStr = atom_to_binary(Args, latin1); + AtomBinStr = eFmt:writeAtom(Args, latin1); _ -> - AtomBinStr = atom_to_binary(Args, uft8) + AtomBinStr = eFmt:writeAtom(Args, uft8) end, string(AtomBinStr, Width, Adjust, Precision, PadChar, Encoding); ctlSmall($e, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_float(Args) -> @@ -291,45 +289,23 @@ buildLimited([OneCA | Cs], NumOfPs, Count, MaxLen, I, Acc) -> case OneCA of #fmtSpec{ctlChar = CtlChar, args = Args, width = Width, adjust = Adjust, precision = Precision, padChar = PadChar, encoding = Encoding, strings = Strings} -> MaxChars = if MaxLen < 0 -> MaxLen; true -> MaxLen div Count end, - S = ctlLimited(CtlChar, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, MaxChars, I), - NewNumOfPs = decr_pc(CtlChar, NumOfPs), + IoListStr = ctlLimited(CtlChar, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, MaxChars, I), + NewNumOfPs = decrPc(CtlChar, NumOfPs), NewCount = Count - 1, - MaxLen = if - MaxLen < 0 -> % optimization - MaxLen; - true -> - Len = eFmt:charsLen(S), - remainChars(MaxLen, Len) - end, + MaxLen = ?IIF(MaxLen < 0, MaxLen, remainChars(MaxLen, eFmt:charsLen(IoListStr))), if - NewNumOfPs > 0 -> [S | buildLimited(Cs, NewNumOfPs, NewCount, - MaxLen, indentation(S, I))]; - true -> [S | buildLimited(Cs, NewNumOfPs, NewCount, MaxLen, I)] + NewNumOfPs > 0 -> + buildLimited(Cs, NewNumOfPs, NewCount, MaxLen, I, [IoListStr | Acc]); + true -> + buildLimited(Cs, NewNumOfPs, NewCount, MaxLen, I, [IoListStr | Acc]) end; _ -> - buildLimited(Cs, NewNumOfPs, NewCount, MaxLen, I + 1, [OneCA | Acc]) + buildLimited(Cs, NumOfPs, Count, MaxLen, I + 1, [OneCA | Acc]) end. - -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 :: eFmt: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. - +decrPc($p, Pc) -> Pc - 1; +decrPc($P, Pc) -> Pc - 1; +decrPc(_, Pc) -> Pc. %% (CtlChar, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, MaxChars, I) ctlLimited($s, Args, Width, Adjust, Precision, PadChar, Encoding, _Strings, CharsLimit, _I) -> @@ -346,26 +322,16 @@ ctlLimited($s, Args, Width, Adjust, Precision, PadChar, Encoding, _Strings, Char TemBinStr = strToChars(BinStr, Width, CharsLimit), string(TemBinStr, ?IIF(CharsLimit < 0 orelse Width =:= none, Width, max(3, min(Width, CharsLimit))), Adjust, Precision, PadChar, Encoding); ctlLimited($w, Args, Width, Adjust, Precision, PadChar, Encoding, _Strings, CharsLimit, _I) -> - Chars = eFmt:write(Args, [{depth, -1}, {encoding, Encoding}, {chars_limit, CharsLimit}]), + Chars = eFmt:doWrite(Args, -1, Encoding, CharsLimit), term(Chars, Width, Adjust, Precision, PadChar); ctlLimited($p, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I) -> print(Args, -1, Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I); -ctlLimited($W, [Args, Depth], Width, Adjust, Precision, PadChar, Encoding, _Strings, CharsLimit, _I) - when is_integer(Depth) -> - Chars = eFmt:write(Args, [{depth, Depth}, {encoding, Encoding}, {chars_limit, CharsLimit}]), +ctlLimited($W, [Args, Depth], Width, Adjust, Precision, PadChar, Encoding, _Strings, CharsLimit, _I) -> + Chars = eFmt:doWrite(Args, Depth, Encoding, CharsLimit), term(Chars, Width, Adjust, Precision, PadChar); -ctlLimited($P, [Args, Depth], Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I) - when is_integer(Depth) -> +ctlLimited($P, [Args, Depth], Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I) -> print(Args, Depth, Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I). --ifdef(UNICODE_AS_BINARIES). -uniconv(C) -> - unicode:characters_to_binary(C, unicode). --else. -uniconv(C) -> - C. --endif. - %% term(TermList, Field, Adjust, Precision, PadChar) %% Output the characters in a term. %% Adjust the characters within the field if length less than Max padding @@ -453,216 +419,8 @@ floatG(Float, Width, Adjust, Precision, PadChar) -> floatE(Float, Width, Adjust, Precision, PadChar) end. - -%% 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). - - - - -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, remainChars(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. +floatG(Float) -> + float_to_binary(Float, [{decimals, 6}]). strToChars(BinStr, Width, CharsLimit) -> ByteSize = byte_size(BinStr), @@ -680,37 +438,6 @@ strToChars(BinStr, Width, CharsLimit) -> <<(binary:part(BinStr, 0, CharsLimit))/binary, "...">> 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, remainChars(CharsLimit, 3), normal). % three dots - -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(Str, Width, Adjust, Precision, PadChar, Encoding) -> if Width == none andalso Precision == none -> @@ -842,53 +569,6 @@ getOpt(Key, TupleList, Default) -> Default end. -%% 将预先解析的格式列表还原为纯字符列表和参数列表。 --spec unscan(FormatList) -> {Format, Data} when - FormatList :: [char() | eFmt: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) -> "". - - toLowerStr(BinStr) -> << begin case C >= $A andalso C =< $Z of