Skip to content

Commit

Permalink
FIXED: formatting of floats in library(format)
Browse files Browse the repository at this point in the history
This addresses mthom#2771, using a new internal predicate resorting to
to_string().

Many thanks to Trevor Merrifield for reporting this issue!

There is still room for improvements: With better support for
inspecting floats, more of this logic can be moved to Prolog; also,
there may be a way to obtain the float with greater precision,
and with fewer needed Rust primitives.
  • Loading branch information
triska committed Jan 16, 2025
1 parent 00e6e32 commit d9a7305
Show file tree
Hide file tree
Showing 4 changed files with 65 additions and 31 deletions.
4 changes: 4 additions & 0 deletions build/instructions_template.rs
Original file line number Diff line number Diff line change
Expand Up @@ -343,6 +343,8 @@ enum SystemClauseType {
NoSuchPredicate,
#[strum_discriminants(strum(props(Arity = "2", Name = "$number_to_chars")))]
NumberToChars,
#[strum_discriminants(strum(props(Arity = "2", Name = "$float_to_chars")))]
FloatToChars,
#[strum_discriminants(strum(props(Arity = "2", Name = "$number_to_codes")))]
NumberToCodes,
#[strum_discriminants(strum(props(Arity = "3", Name = "$op")))]
Expand Down Expand Up @@ -1769,6 +1771,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallNextEP |
&Instruction::CallNoSuchPredicate |
&Instruction::CallNumberToChars |
&Instruction::CallFloatToChars |
&Instruction::CallNumberToCodes |
&Instruction::CallOpDeclaration |
&Instruction::CallOpen |
Expand Down Expand Up @@ -2007,6 +2010,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteNextEP |
&Instruction::ExecuteNoSuchPredicate |
&Instruction::ExecuteNumberToChars |
&Instruction::ExecuteFloatToChars |
&Instruction::ExecuteNumberToCodes |
&Instruction::ExecuteOpDeclaration |
&Instruction::ExecuteOpen |
Expand Down
68 changes: 37 additions & 31 deletions src/lib/format.pl
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2020-2024 by Markus Triska ([email protected])
Written 2020-2025 by Markus Triska ([email protected])
Part of Scryer Prolog.
I place this code in the public domain. Use it in any way you want.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
Expand Down Expand Up @@ -284,36 +284,12 @@
cells(Fs, Args, 0, [], VNs).
cells([~,s|Fs], [Arg|Args], Tab, Es, VNs) --> !,
cells(Fs, Args, Tab, [chars(Arg)|Es], VNs).
cells([~,f|Fs], [Arg|Args], Tab, Es, VNs) --> !,
{ G = format_number_chars(Arg, Chars) },
cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs).
cells([~,f|Fs], Args, Tab, Es, VNs) --> !,
cells([~,'6',f|Fs], Args, Tab, Es, VNs).
cells([~|Fs0], Args0, Tab, Es, VNs) -->
{ numeric_argument(Fs0, Num, [f|Fs], Args0, [Arg|Args]) },
!,
{ G = (format_number_chars(Arg, Cs0),
phrase(upto_what(Bs, .), Cs0, Cs),
( Num =:= 0 -> Chars = Bs
; ( Cs = ['.'|Rest] ->
length(Rest, L),
( Num < L ->
length(Ds, Num),
append(Ds, _, Rest)
; Num =:= L ->
Ds = Rest
; Num > L,
Delta is Num - L,
% we should look into the float with
% greater accuracy here, and use the
% actual digits instead of 0.
length(Zs, Delta),
maplist(=('0'), Zs),
append(Rest, Zs, Ds)
)
; length(Ds, Num),
maplist(=('0'), Ds)
),
append(Bs, ['.'|Ds], Chars)
)) },
{ G = float_digits_chars(Arg, Num, Chars) },
cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs).
cells([~,r|Fs], Args, Tab, Es, VNs) --> !,
cells([~,'8',r|Fs], Args, Tab, Es, VNs).
Expand Down Expand Up @@ -368,9 +344,30 @@
Fs1 = [_|_] },
cells(Fs, Args, Tab, [chars(Fs1)|Es], VNs).

format_number_chars(N0, Chars) :-
N is N0, % evaluate compound expression
number_chars(N, Chars).

float_digits_chars(F0, Num, Chars) :-
F is float(F0), % evaluate compound expression and convert to float
'$float_to_chars'(F, Cs0),
phrase(upto_what(Bs, .), Cs0, Cs),
( Num =:= 0 -> Chars = Bs
; ( Cs = ['.'|Rest] ->
length(Rest, L),
( Num < L ->
length(Ds, Num),
append(Ds, _, Rest)
; Num =:= L ->
Ds = Rest
; Num > L,
Delta is Num - L,
length(Zs, Delta),
maplist(=('0'), Zs),
append(Rest, Zs, Ds)
)
; length(Ds, Num),
maplist(=('0'), Ds)
),
append(Bs, ['.'|Ds], Chars)
).

n_newlines(N0) --> { N0 > 0, N is N0 - 1 }, [newline], n_newlines(N).
n_newlines(0) --> [].
Expand Down Expand Up @@ -564,6 +561,15 @@
?- format("~12r", [300]).
210 true.
?- format("~f", [3]).
3.000000 true.
?- format("~6f", [1.0e20]).
100000000000000000000.000000 true.
?- format("~50f", [3.0e-20]).
0.00000000000000000003000000000000000000000000000000 true.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Expand Down
8 changes: 8 additions & 0 deletions src/machine/dispatch.rs
Original file line number Diff line number Diff line change
Expand Up @@ -3750,6 +3750,14 @@ impl Machine {
self.number_to_chars();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallFloatToChars => {
self.float_to_chars();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteFloatToChars => {
self.float_to_chars();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallNumberToCodes => {
self.number_to_codes();
step_or_fail!(self, self.machine_st.p += 1);
Expand Down
16 changes: 16 additions & 0 deletions src/machine/system_calls.rs
Original file line number Diff line number Diff line change
Expand Up @@ -2834,6 +2834,22 @@ impl Machine {
self.machine_st.unify_complete_string(chars_atom, chs);
}

#[inline(always)]
pub(crate) fn float_to_chars(&mut self) {
let n = self.deref_register(1);
let chs = self.deref_register(2);

let string = match Number::try_from(n) {
Ok(Number::Float(OrderedFloat(n))) => n.to_string(),
_ => {
unreachable!()
}
};

let chars_atom = AtomTable::build_with(&self.machine_st.atom_tbl, string.trim());
self.machine_st.unify_complete_string(chars_atom, chs);
}

#[inline(always)]
pub(crate) fn number_to_codes(&mut self) {
let n = self.deref_register(1);
Expand Down

0 comments on commit d9a7305

Please sign in to comment.