mercury/extras/fixed/fixed.m

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2006, 2011 The University of Melbourne.
% Copyright (C) 2015, 2018, 2025 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: fixed.m
% Author: Peter Ross <pro@missioncriticalit.com>
%
% Implementation of fixed point arithmetic which is equivalent to cobol
% fixed point arithmetic.
%
%---------------------------------------------------------------------------%

:- module fixed.
:- interface.

%---------------------------------------------------------------------------%

    % Represents a fixed point number at some given precision.
    %
:- type fixed.

%---------------------------------------------------------------------------%

:- func - fixed = fixed.
:- func fixed + fixed = fixed.
:- func fixed - fixed = fixed.
:- func fixed * fixed = fixed.

    % div(MinP, A, B) is A / B where the result has
    % to have at least a precision MinP.
    %
:- func div(int, fixed, fixed) = fixed.

    % Increase or decrease the precision of the given fixed.
    % We decrease the precision by truncating the result.
    %
:- func precision(int, fixed) = fixed.

    % Return the integer part of the fixed point number.
    %
:- func to_int(fixed) = int.

    % Given a fixed return the floating point number
    % which represents that fixed point number.
    %
:- func to_float(fixed) = float.

    % truncate(P, F) truncates the number, F, to precision, P.
    %
:- func truncate(int, fixed) = fixed.

    % round(P, F) rounds the number, F, to precision, P.
    %
:- func round(int, fixed) = fixed.

    % Is the given floating point number equal to zero?
    %
:- pred is_zero(fixed::in) is semidet.

    % Determine the precision with which the given number
    % is stored.
    %
:- func fixed_precision(fixed) = int.

    % Compare two fixed point numbers.
    %
:- func compare_fixed(fixed::in, fixed::in) = (comparison_result::uo) is det.

    % Get the fractional part of a fixed point number as a string.
    %
:- func get_fraction_part_string(fixed) = string.

    % Get the integral part of a fixed point number as % a string.
    %
:- func get_whole_part_string(fixed) = string.

%---------------------------------------------------------------------------%
%
% Comparison operators for fixed point numbers.
%

:- pred (fixed::in) == (fixed::in) is semidet.
:- pred (fixed::in) \== (fixed::in) is semidet.

:- pred (fixed::in) < (fixed::in) is semidet.
:- pred (fixed::in) > (fixed::in) is semidet.
:- pred (fixed::in) =< (fixed::in) is semidet.
:- pred (fixed::in) >= (fixed::in) is semidet.

%---------------------------------------------------------------------------%

:- typeclass fixed(T) where [
    % Return the fixed point representation of T, with the supplied precision.
    func to_fixed(int, T) = fixed
].

:- instance fixed(int).

    % The float is rounded.
:- instance fixed(float).

    % The string is truncated.
:- instance fixed(string).

    % Output a fixed point number as a string.
    %
:- func to_string(fixed) = string.

    % Given a string, return the fixed which represents that string.
    %
:- func to_fixed(string) = fixed.

%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- implementation.

:- import_module char.
:- import_module float.
:- import_module int.
:- import_module integer.
:- import_module list.
:- import_module require.
:- import_module string.

%---------------------------------------------------------------------------%

:- type fixed
    --->    fixed(
                precision :: int,
                number    :: integer
            ).

%---------------------------------------------------------------------------%

- fixed(P, N) = fixed(P, integer(-1) * N).

X + Y = fixed(P, A + B) :-
    compare(Result, X ^ precision, Y ^ precision),
    (
        Result = (<),
        P = Y ^ precision,
        A = precision(P, X) ^ number,
        B = Y ^ number
    ;
        Result = (=),
        P = X ^ precision,
        A = X ^ number,
        B = Y ^ number
    ;
        Result = (>),
        P = X ^ precision,
        A = X ^ number,
        B = precision(P, Y) ^ number
    ).

X - Y = fixed(P, A - B) :-
    compare(Result, X ^ precision, Y ^ precision),
    (
        Result = (<),
        P = Y ^ precision,
        A = precision(P, X) ^ number,
        B = Y ^ number
    ;
        Result = (=),
        P = X ^ precision,
        A = X ^ number,
        B = Y ^ number
    ;
        Result = (>),
        P = X ^ precision,
        A = X ^ number,
        B = precision(P, Y) ^ number
    ).

X * Y = fixed(X ^ precision + Y ^ precision, X ^ number * Y ^ number).

div(MinP, X, Y) = fixed(P, N) :-
    Diff = X ^ precision - Y ^ precision,
    ( if Diff < MinP then
        P = MinP,
        N = (X ^ number * scale(MinP - Diff)) // Y ^ number
    else
        P = Diff,
        N = X ^ number // Y ^ number
    ).

precision(DesiredP, fixed(ActualP, N0)) = fixed(DesiredP, N) :-
    compare(Result, DesiredP, ActualP),
    (
        Result = (<),
        N = N0 // scale(ActualP - DesiredP)
    ;
        Result = (=),
        N = N0
    ;
        Result = (>),
        N = N0 * scale(DesiredP - ActualP)
    ).

:- func scale(int) = integer.

scale(X) = integer(10) `pow` integer(X).

truncate(DesiredP, F) = precision(DesiredP, F).

round(DesiredP, fixed(ActualP, N0)) = fixed(DesiredP, N) :-
    compare(Result, DesiredP, ActualP),
    (
        Result = (<),
        Scale = scale(ActualP - DesiredP),
        Rem = N0 rem Scale,
        ( if Rem << 1 >= Scale then
            N = N0 // Scale + integer.one
        else
            N = N0 // Scale
        )
    ;
        Result = (=),
        N = N0
    ;
        Result = (>),
        N = N0 * scale(DesiredP - ActualP)
    ).

is_zero(N) :-
    integer.is_zero(N ^ number).

fixed_precision(N) = N ^ precision.

%---------------------------------------------------------------------------%

X == Y :-
    Result = compare_fixed(X, Y),
    Result = (=).

X \== Y :-
    Result = compare_fixed(X, Y),
    ( Result = (>)
    ; Result = (<)
    ).

X < Y :-
    Result = compare_fixed(X, Y),
    Result = (<).

X > Y :-
    Result = compare_fixed(X, Y),
    Result = (>).

X =< Y :-
    Result = compare_fixed(X, Y),
    ( Result = (<)
    ; Result = (=)
    ).

X >= Y :-
    Result = compare_fixed(X, Y),
    ( Result = (>)
    ; Result = (=)
    ).

compare_fixed(X, Y) = Result :-
    Z = (X - Y) ^ number,
    ( if Z < integer.zero then
        Result = (<)
    else if Z = integer.zero then
        Result = (=)
    else
        Result = (>)
    ).

%---------------------------------------------------------------------------%

:- instance fixed(int) where [
    to_fixed(N, I) = fixed(N, integer(I) * (integer(10) `pow` integer(N)))
].

:- instance fixed(float) where [
    to_fixed(N, F) = to_fixed(N, string.format(Spec, [f(F)])) :-
    Spec = string.format("%%.%df", [i(N)])
].

:- instance fixed(string) where [
    to_fixed(N, S) = fixed(N, scaled_integer(N, S))
].

%---------------------------------------------------------------------------%

to_string(fixed(N, Int)) = Str :-
    ( if N = 0 then
        Str = integer.to_string(Int)
    else
        Cs0 = to_char_list(integer.to_string(Int)),
        insert_decimal_point(N, Cs0, P, Cs1),
        ( if N >= P then
            Cs = ['0', '.'] ++ list.duplicate(N - P, '0') ++ Cs1
        else
            Cs = Cs1
        ),
        Str = from_char_list(Cs)
    ).

:- pred insert_decimal_point(int::in, list(char)::in,
    int::out, list(char)::out) is det.

insert_decimal_point(_, [], 0, []).
insert_decimal_point(N, [C | Cs], P + 1, L) :-
    insert_decimal_point(N, Cs, P, L0),
    ( if N = P then
        L = [C, '.' | L0]
    else
        L = [C | L0]
    ).

%---------------------------------------------------------------------------%

to_int(F) = det_to_int(I) :-
    fixed(_, I) = precision(0, F).

to_float(fixed(P, N)) = float(N) / pow(10.0, P).

%---------------------------------------------------------------------------%

    % Deterministic version of scaled_integer which throws an error, instead
    % of failing.
    %
:- func scaled_integer(int, string) = integer.

scaled_integer(N, Str) =
    ( if scaled_integer(N, Str, ScaledInteger) then
        ScaledInteger
    else
        func_error("scaled_integer: " ++ Str)
    ).

    % scaled_integer(N, S, SI) is true iff
    % SI is a scaled integer which represents the string, S, as a fixed
    % point number of order N.
    %
    % Fails if S doesn't represent a number.
    %
    % Note that SI is a truncated version of S, if S has greater precision
    % than N. eg fixed(1, "1.36", integer(13)) is true, there is no rounding.
    %
:- pred scaled_integer(int::in, string::in, integer::out) is semidet.

scaled_integer(N, Str, ScaledInteger) :-
    Str \= "",
    L = to_char_list(Str),
    ( if L = ['-' | Cs] then
        scaled_integer(N, Cs, integer(0), ScaledInteger0),
        ScaledInteger = integer(-1) * ScaledInteger0
    else if L = ['+' | Cs] then
        scaled_integer(N, Cs, integer(0), ScaledInteger)
    else
        scaled_integer(N, L, integer(0), ScaledInteger)
    ).


:- pred scaled_integer(int::in, list(char)::in,
    integer::in, integer::out) is semidet.

scaled_integer(N, [], A0, A) :-
    A = A0 * scale(N).
scaled_integer(N, [C|Cs], A0, A) :-
    ( if C = ('.') then
        L = list.take_upto(N, Cs),
        fraction(L, A0, A1),
        A = A1 * (integer(10) `pow` integer(N - length(L)))
    else
        decimal_digit_to_int(C, I),
        scaled_integer(N, Cs, A0 * integer(10) + integer(I), A)
    ).

:- pred fraction(list(char)::in, integer::in, integer::out) is semidet.

fraction([], A, A).
fraction([C | Cs], A0, A) :-
    decimal_digit_to_int(C, I),
    fraction(Cs, A0 * integer(10) + integer(I), A).

%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- import_module maybe.

to_fixed(Str) = Fixed :-
    L = to_char_list(Str),
    ( if L = ['-' | Cs] then
        Factor = integer(-1),
        List = Cs
    else if L = ['+' | Cs] then
        Factor = integer(+1),
        List = Cs
    else if L = [_ | _] then
        Factor = integer(+1),
        List = L
    else
        error("to_fixed: empty string")
    ),
    ( if parse_fixed(List, integer(0), N0, no, P) then
        N = Factor * N0,
        Fixed = fixed(P, N)
    else
        error("to_fixed: " ++ Str)
    ).

:- pred parse_fixed(list(char)::in, integer::in, integer::out,
    maybe(int)::in, int::out) is semidet.

parse_fixed([], I, I, no, 0).
parse_fixed([], I, I, yes(P), P).
parse_fixed([C | Cs], I0, I, no, P) :-
    ( if C = ('.') then
        parse_fixed(Cs, I0, I, yes(0), P)
    else
        decimal_digit_to_int(C, CInt),
        parse_fixed(Cs, integer(10) * I0 + integer(CInt), I, no, P)
    ).
parse_fixed([C | Cs], I0, I, yes(P0), P) :-
    decimal_digit_to_int(C, CInt),
    parse_fixed(Cs, integer(10) * I0 + integer(CInt), I, yes(P0 + 1), P).

%---------------------------------------------------------------------------%

get_fraction_part_string(fixed(Precision, N)) = FracStr :-
    FracPart = N mod pow(integer(10), integer(Precision)),
    FracStr = to_string(FracPart).

get_whole_part_string(fixed(Precision, N)) = WholeStr :-
    WholePart = N div pow(integer(10), integer(Precision)),
    WholeStr = to_string(WholePart).

%---------------------------------------------------------------------------%
:- end_module fixed.
%---------------------------------------------------------------------------%