%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% A test module similar to string, with only a format predicate.
% Imports many things from string.m.  Prints out every character in the
% format string twice (instead of once), and writes `Ostring' instead
% of an argument string.

:- module qual_strung.

:- interface.
:- import_module list.
:- import_module string.

:- pred format(string, list(poly_type), string).
:- mode format(in, in, out) is det.

:- func format_func(string, list(poly_type)) = string.
:- mode format_func(in, in) = out is det.

:- implementation.
:- import_module bool.
:- import_module char.
:- import_module float.
:- import_module int.
:- import_module require.
:- import_module std_util.

format_func(FString, PolyList) = String :-
    qual_strung.format(FString, PolyList, String).

format( Fstring, Poly_list, Ostring ) :-
    to_char_list(Fstring, Clist),
    format_2a(Clist, Poly_list, Ostring) .

:- pred format_2a(list(char), list(poly_type), string).
:- mode format_2a(in, in, out) is det.
%
%   format_2a( stream, char_f, vars, IO, IO).
%       The main function, with different input types.
%
%   Accumulator recursion is not used, as it would involve adding a
%   short string to the end of a long string many times, which I understand
%   is not efficient.  Instead, many short strings are added to the front
%   of a (long) and growing string.
%
format_2a( [], _, "").
format_2a( [Achar | As], Vars_in, Ostring) :-
    (
        Achar = '%'
    ->
        (
            As = ['%' | Ass]
        ->
            format_2a(Ass, Vars_in, Temp_out),
            first_char(Ostring, '%', Temp_out)
        ;
            (
                format_top_convert_variable(As, As_out,
                    Vars_in, Vars_out, String_1)
            ->
                format_2a(As_out, Vars_out, String_2),
                append(String_1, String_2, Ostring)
            ;
                error("format: Too few variables.")
            )
        )
    ;
        format_2a(As, Vars_in, Temp_out),
        first_char(OOstring, Achar, Temp_out),
        first_char(Ostring, Achar, OOstring)
    ).

:- pred format_top_convert_variable( list(char), list(char),
        list(poly_type), list(poly_type), string).
:- mode format_top_convert_variable(in, out, in, out, out) is semidet.
%
%    format_top_convert_variable( formated string in, out, var in, out,
%           Out string)
%       Return a string of the formatted variable.
%
format_top_convert_variable(['%' | Bs], Bs, [], [], "%").
            % Above rule should not be executed... defensive rule.
format_top_convert_variable( F_chars_in, F_chars_out,
            [Var_in | Vars_l_in], Vars_out, Out_string ) :-
    format_takewhile1( F_chars_in, [Conv_char_0 | F_chars_out],
            Fmt_info),
                 %  Seperate formatting info from formatting string.
                 %  in, out, out
    format_get_optional_args( Fmt_info, Flags, Int_width,
            Int_precis, Conv_modify),
                 %  Parse formatting info.
                 %  in, out, out, out, out.
    format_mod_conv_char( Precision, Var_in, Conv_char_1,
            Conv_char_0),
                 %  Modify(?) conversion character.
                 %  in, in, out, in
    format_do_mod_char( Conv_modify, Conv_char_2, Conv_char_1),
                 %  Interperate input conversion modifiers.
                 %  in, out, in
    format_read_star( Vars_out, Vars_l_in, Width, Int_width,
            Precision, Int_precis),
                 %  Do something if a precision or width was '*'
                 %  out, in, out, in, out, in
    format_do_conversion(Conv_char_2, Var_in, Ostring, Precision,
            Flags, Move_i0),
                 %  Actually convert a Variable to a string
                 %  in, out, in, in, out, in, in, out
    format_add_sign( Ostring2, Ostring, Flags, Var_in, Move_i0,
            Move_i1),
                 %  Adds an optional '+' or ' ' to string.
                 %  out, in, in, in, in, out
    format_pad_width( Ostring2, Width, Flags, Out_string, Move_i1).
                 %  Ensures that the string is at least width.
                 %  in, in, in, out, in

%
%   Change conversion character.
%
%   Ideally the outer "->" symbols could be removed, the last case given
%   a guard, and the compiler accept this as det, rather than non-det.
%
:- pred format_mod_conv_char( int, poly_type, char, char).
:- mode format_mod_conv_char( in, in, out, in) is det.
format_mod_conv_char( Precision, Poly_var, Conv_c_out, Conv_c_in) :-
    ( Conv_c_in = 'i' ->
        Conv_c_out = 'd'        % %d = %i
    ;
    (Conv_c_in = 'g' ->         %g is either %e of %f
        (Poly_var = f(F) ->
            float_abs(F, Ft),
            int.pow(10, Precision, P),
            Pe = float.float(P),
            (
                Ft > 0.0001,
                Pe > Ft
            ->
                Conv_c_out = 'f'
            ;
                Conv_c_out = 'e'
            )
        ;
            error("format:  %g without a f(Float).")
        )
     ;
    (Conv_c_in = 'G' ->     %G is either %E of %f
        (Poly_var = f(F) ->
            float_abs(F, Ft),
            int.pow(10, Precision, P),
            Pe = float.float(P),
            (
                Ft > 0.0001,
                Pe > Ft
            ->
                Conv_c_out = 'f'
            ;
                Conv_c_out = 'E'
            )
        ;
            error("format:  %G without a f(float).")
        )
    ;
        Conv_c_out = Conv_c_in
    ))).

%   This function glances at the input-modification flags, only applicable
%   with a more complicated type system
%
%   Another function that would be better off as a switch.
%
:- pred format_do_mod_char( char, char, char).
:- mode format_do_mod_char( in, out, in) is det.
format_do_mod_char( Char_mods, C_out, C_in) :-
    (
        Char_mods = 'h'
    ->
        C_out = C_in
    ;
    (   Char_mods = 'l'
    ->
        C_out = C_in
    ;
    (   Char_mods = 'L'
    ->
        C_out = C_in
    ;
        C_out = C_in
    ))).

%
%   Change Width or Precision value, if '*' was spcified
%
:- pred format_read_star( list(poly_type), list(poly_type), int, int, int, int).
:- mode format_read_star( out, in, out, in, out, in) is semidet.
format_read_star( Polys_out, Polys_in, Width, Int_width, Precision, Int_precis) :-
    (
        special_precision_and_width(Int_width)
    ->
        Polys_in = [ i(Width) |  Poly_temp]
    ;
        Polys_in = Poly_temp,
        Int_width = Width
    ),
    (
        special_precision_and_width(Int_precis)
    ->
        Poly_temp = [ i(Precision) | Polys_out]
    ;
        Polys_out = Poly_temp,
        Int_precis = Precision
    ).

%
%   This function did the variable conversion to string.
%   Now done by do_conversion_0/6.
%
%
%   Mv_width records the length of the prefix in front of the number,
%   so that it is more easy to insert width and precision padding and
%   optional signs, in the correct place.
%
:- pred format_do_conversion( char, poly_type, string, int,
        list(char), int).
:- mode format_do_conversion( in, in, out, in, in, out)
        is det.
format_do_conversion( Conv_c, Poly_t, Ostring, Precision, Flags,
        Mv_width) :-
    (
        do_conversion_0(Conv_c, Poly_t, Tstring, Precision,
            Flags, TMv_width)
    ->
        TMv_width = Mv_width,
        Ostring = Tstring
    ;
        do_conversion_fail(Conv_c)
    ).

:- pred do_conversion_0(char, poly_type, string, int,
        list(char), int).
:- mode do_conversion_0(in, in, out, in, in, out) is semidet.
do_conversion_0(Conv_c, Poly_t, Ostring, Precision, Flags,
        Mv_width) :-
    (
    Conv_c = 'd',
        Poly_t = i(I),
        int_to_string(I, S),
        format_int_precision(S, Ostring, Precision, _),
        (
            I < 0
        ->
            Mv_width = 1
        ;
            Mv_width = 0
        )

    ;
    Conv_c = 'o',
        Poly_t = i(I),
        ( I = 0 ->
            S = "0",
            format_int_precision(S, Ostring, Precision, _),
            Pfix_len = 0
        ;
            int_to_base_string(I, 8, S),
            format_int_precision(S, SS, Precision, _),
            ( list.member('#', Flags) ->
                first_char(Ostring, '0', SS),
                Pfix_len = 1
            ;
                Ostring = SS,
                Pfix_len = 0
            )
        ),
        ( I < 0 -> Mv_width = Pfix_len + 1 ; Mv_width = Pfix_len )
    ;
    Conv_c = 'x' ,
        Poly_t = i(I),
        ( I = 0 ->
            SS = "0",
            Pfix_len = 0,
            format_int_precision(SS, Ostring, Precision, _)
        ;
            int_to_base_string(I, 16, S),
            format_int_precision(S, SS, Precision, _),
            (
                list.member( '#', Flags)
            ->
                append( "0x", SS, Ostring),
                Pfix_len = 2
            ;
                Ostring = SS,
                Pfix_len = 0
            )
        ),
        ( I < 0 -> Mv_width = Pfix_len + 1 ; Mv_width = Pfix_len )
    ;
    Conv_c = 'X',
        Poly_t = i(I),
        ( I = 0 ->
            SS = "0",
            Pfix_len = 0,
            format_int_precision(SS, Ostring, Precision, _)
        ;
            int_to_base_string(I, 16, Otemp),
            to_upper(Otemp, S),
            format_int_precision(S, SS, Precision, _),
            ( list.member( '#', Flags) ->
                append( "0X", SS, Ostring),
                Pfix_len = 2
            ;
                SS = Ostring,
                Pfix_len = 0
            )
        ),
        ( I < 0 -> Mv_width = Pfix_len + 1 ; Mv_width = Pfix_len )
    ;
    Conv_c = 'u' ,
        Poly_t = i(I),
        int.abs(I, J),
        int_to_string(J, S),
        format_int_precision(S, Ostring, Precision, Mvt),
        Mv_width = Mvt
    ;
    Conv_c = 'c' ,
        Poly_t = c(C),
        char_to_string( C, Ostring),
        Mv_width = 0
    ;
    Conv_c = 's' ,
        Poly_t = s(S),
        ( default_precision_and_width(Precision) ->
            Ostring = "Ostring"
        ;
            split(S, Precision, Ostring, _)
        ),
        Mv_width = 0
    ;
    Conv_c = 'f' ,
        Poly_t = f(F),
        float_to_string(F, Fstring),
        format_calc_prec(Fstring, Ostring, Precision),
        (F < 0.0 -> Mv_width = 1 ; Mv_width = 0)
    ;
    Conv_c = 'e',
        Poly_t = f(F),
        format_calc_exp(F, Ostring, Precision, 0),
        (F < 0.0 -> Mv_width = 1 ; Mv_width = 0)
    ;
    Conv_c = 'E' ,
        Poly_t = f(F),
        format_calc_exp(F, Otemp, Precision, 0),
        to_upper(Otemp, Ostring),
        (F < 0.0 -> Mv_width = 1 ; Mv_width = 0)
    ;
    Conv_c = 'p' ,
        Poly_t = i(I),
        int_to_string(I, Ostring),
        ((I < 0) -> Mv_width = 1 ; Mv_width = 0)
    ).

:- pred do_conversion_fail(char).
:- mode do_conversion_fail(in) is erroneous.
do_conversion_fail(Conv_c) :-
    qual_strung.format("%s `%%%c', without a correct poly-variable.",
        [s("format: statement has used type"), c(Conv_c)],
        Error_message),
    error(Error_message).

%
%   Use precision information to modify string.  - for integers
%
:- pred format_int_precision(string, string, int, int).
:- mode format_int_precision( in, out, in, out) is semidet.
format_int_precision(S, Ostring, Precision, Added_width) :-
    ( default_precision_and_width(Precision) ->
        Prec = 0
    ;
        Prec = Precision
    ),
    length(S, L),
    ( first_char(S, '-', _) ->
        Xzeros = Prec - L + 1
    ;
        Xzeros = Prec - L
    ),
    Added_width = Xzeros,
    ( Xzeros > 0 ->
        duplicate_char( '0', Xzeros, Pfix),
        first_char(S, C, Rest),
        (
            C \= ('-'),
            C \= ('+')
        ->
            append(Pfix, S, Ostring)
        ;
            append( Pfix, Rest, Temps),
            first_char( Ostring, C, Temps)
        )
    ;
        Ostring = S
    ).

%   Function  to calculate exponent for a %e conversion of a float
%
:- pred format_calc_exp(float, string, int, int).
:- mode format_calc_exp(in, out, in, in) is det.
format_calc_exp(F, Fstring, Precision, Exp) :-
    ( F < 0.0 ->
        Tf = 0.0 - F,
        format_calc_exp( Tf, Tst, Precision, Exp),
        first_char(Fstring, '-', Tst)
    ;
        ( F < 1.0 ->
            Texp = Exp - 1,
            FF = F * 10.0,
            format_calc_exp( FF, Fstring, Precision, Texp)
        ;
        ( F >= 10.0 ->
            Texp = Exp + 1,
            FF = F / 10.0,
            format_calc_exp( FF, Fstring, Precision, Texp)
        ;
            float_to_string(F, Fs),
            format_calc_prec(Fs, Fs2, Precision),
            int_to_string(Exp, Exps),
            ( Exp < 0 ->
                append( "e", Exps, TFstring),
                append( Fs2, TFstring, Fstring)
            ;
                append( "e+", Exps, TFstring),
                append( Fs2, TFstring, Fstring)
            )
        )
        )
    ).

%
%   This precision output-modification predicate handles floats.
%
:- pred format_calc_prec(string, string, int).
:- mode format_calc_prec(in, out, in) is det.
format_calc_prec(Istring, Ostring, Precision) :-
    (
        default_precision_and_width(Precision)
    ->
        Prec = 6
    ;
        Prec = Precision
    ),
    (
        find_index( Istring, '.', Index)
    ->
        Spa = Prec + Index
    ;
        length(Istring, Spa_0),
        Spa = Spa_0 + 1
        %  This branch should never be called if mercury is implemented
        %  in ansi-C, according to Kernighan and Ritchie p244, as a
        %  float converted to a string using sprintf should always have
        %  a decimal point.  (where specified precision != 0.
        %  float_to_string doesn't specify a precision to be
        %  used.)  If a future implementation changes the
        %  way float_to_string is implemented, and a float can
        %  be converted to a string without a decimal point, then this
        %  rule would be useful.  It is not expected that
        %  float_to_string will ever produce %e style output.
    ),
    (
        length(Istring, L1),
        L1 < Spa
    ->
        duplicate_char('0', Precision, P0s),
        append( Istring, P0s, Mstring)
    ;
        Mstring = Istring
    ),
    (
        Precision = 0
    ->
        Space = Spa - 1
    ;
        Space = Spa
    ),
    split(Mstring, Space, Ostring, _).

%   find_index is a funky little predicate to find the first
%   occurrence of a particular character in a string.

:- pred find_index( string, char, int).
:- mode find_index( in, in, out) is semidet.
find_index(Str, C, Index) :-
    to_char_list(Str, List),
    find_index_2(List, C, Index).

:- pred find_index_2(list(char), char, int).
:- mode find_index_2(in, in, out) is semidet.
find_index_2([], _C, _Index) :- fail.
find_index_2([X | Xs], C, Index) :-
    (
        X = C
    ->
        Index = 1
    ;
        find_index_2(Xs, C, Index0),
        Index = Index0 + 1
    ).

%find_index( A, Ch, Check, Ret) :-
%   (
%       length(A, Len),
%       Len < Check
%   ->
%       fail
%   ;
%       index(A, Check, Ch)
%   ->
%       Ret = Check
%   ;
%       Check2 is Check + 1,
%       find_index( A, Ch, Check2, Ret)
%   ).
%

%   Add a '+' or ' ' sign, if it is needed in this output.
%
:- pred format_add_sign( string, string, list(char), poly_type,
            int, int).
:- mode format_add_sign( out, in, in, in, in, out) is det.
%           Mvw is the prefix-length in front of the number.
format_add_sign( Ostring, Istring, Flags, _V, Mvw1, Mvw2) :-
    T1 = Mvw1 - 1,
    (
        index(Istring, T1, '-')
    ->
        Ostring = Istring,
        Mvw2 = Mvw1
    ;
        split(Istring, Mvw1, Lstring, Rstring),
        (
            list.member(('+'), Flags)
        ->
            append( "+", Rstring, Astring),
            append( Lstring, Astring, Ostring),
            Mvw2 = Mvw1 + 1
        ;
            (
                list.member(' ', Flags)
            ->
                append( " ", Rstring, Astring),
                append( Lstring, Astring, Ostring),
                Mvw2 = Mvw1 + 1
            ;
                Ostring = Istring,
                Mvw2 = Mvw1
            )
        )
    ).

%
% This function pads some characters to the left or right of a string that is
% shorter than it's width.
%
:- pred format_pad_width( string, int, list(char), string, int).
:- mode format_pad_width( in, in, in, out, in) is det.
%       ( String in, width, flags, Output string, #Moveables).
format_pad_width( Istring, Width, Flags, Out_string, Mv_cs) :-
    length(Istring, Len),
    (Len < Width ->
        % time for some FLAG tests
        Xspace = Width - Len,
        (
            list.member('0', Flags)
        ->
            Pad_char = '0'
        ;
            Pad_char = ' '
        ),
        duplicate_char(Pad_char, Xspace, Pad_string),
        (
            list.member('-', Flags)
        ->
            append(Istring, Pad_string, Out_string)
        ;
            (
                list.member('0', Flags)
            ->
                split(Istring, Mv_cs, B4, After),
                append( Pad_string, After, Astring),
                append( B4, Astring, Out_string)
            ;
                append( Pad_string, Istring, Out_string)
            )
        )
    ;
        Out_string = Istring
    ).

:- pred format_get_optional_args( list(char), list(char), int, int, char).
:- mode format_get_optional_args( in, out, out, out, out) is det.
%   format_get_optional_args( format info, flags, width, precision, modifier)
%       format is assumed to be in ANSI C format.
%       p243-4 of Kernighan & Ritchie 2nd Ed. 1988
%       "Parse" format informtion.
%
% A function to do some basic parsing on the optional printf arguments.
%
% The ites make this det.  It would be nicer to see a det switch on A, but the
% determinism checker does not `see' the equity tests that are hidden one layer
% further down.
%
format_get_optional_args( [], Flags, Width, Precision, Mods) :-
        Flags = [],
        Width = 0,
        default_precision_and_width(Precision),
        Mods = ' '.
format_get_optional_args( [A | As], Flags, Width, Precision, Mods) :-
    (
        (A = (-) ; A = (+) ; A = ' ' ; A = '0' ; A = '#' )
    ->
        format_get_optional_args( As, Oflags, Width, Precision, Mods),
        UFlags = [A | Oflags],
        list.sort_and_remove_dups(UFlags, Flags)
    ;
    (
        ( A = (.) ; A = '1' ; A = '2' ; A = '3' ; A = '4' ;
          A = '5' ; A = '6' ; A = '7' ; A = '8' ; A = '9' )
    ->
        format_string_to_ints([A | As], Bs, Numl1, Numl2, yes),
        format_int_from_char_list( Numl1, Width),
        format_int_from_char_list( Numl2, Prec),
        format_get_optional_args( Bs, Flags, _, Ptemp, Mods),
        (Numl2 = [] ->
            Precision = Ptemp
        ;
            Precision = Prec
        )
    ;
    (   ( A = 'h' ; A = 'l' ; A = 'L' )
    ->
        Mods = A,
        format_get_optional_args( As, Flags, Width, Precision, _)
    ;
    (   A = ('*')
    ->
        format_get_optional_args( As, Flags, W, P, Mods),
        (
            As = [(.) | _]
        ->
            Precision = P,
            special_precision_and_width(Width)
        ;
            Width = W,
            special_precision_and_width(Precision)
        )
%       (
%           default_precision_and_width(P)
%       ->
%           special_precision_and_width(Precision)
%       ;
%           Precision = P
%       ),
%       special_precision_and_width(Width)
    ;
        error("format:  Unrecognised formatting information\n")
        )
    ))) .

:- pred format_takewhile1(list(char), list(char), list(char)).
:- mode format_takewhile1(in, out, out) is det.
%   format_takewhile(formatted string in, out, format info).
%       A HACK.  Would be much nicer with a proper takewhile.
%       Looses the format info from the front of the first argument,
%       puts this in the last argument, while the second is the
%       remainder of the string.
%
%       XXXXXX
%
format_takewhile1([], [], []).
format_takewhile1( [A | As], Rem, Finf) :-
    (
        ( A = 'd' ; A = 'i' ; A = 'o' ; A = 'x' ; A = 'X' ; A = 'u' ;
          A = 's' ; A = '%' ; A = 'c' ; A = 'f' ; A = 'e' ; A = 'E' ;
          A = 'g' ; A = 'G' ; A = 'p')
    ->
        Rem = [A | As],
        Finf = []
    ;
        format_takewhile1(As, Rem, F),
        Finf = [A | F]
    ).

:- pred format_string_to_ints(list(char), list(char), list(char), list(char), bool).
:- mode format_string_to_ints(in, out, out, out, in) is det.
%           ( String in, out, Number1, Number2, seen '.' yet?)
%       Takes in a char list and splits off the rational number at the
%       start of the list.  This is split into 2 parts - an int and a
%       fraction.
%
format_string_to_ints( [], [], [], [], _).
format_string_to_ints( [A | As], Bs, Int1, Int2, Bool) :-
    ( char.is_digit(A) ->
        ( Bool = yes ->
            format_string_to_ints( As, Bs, I1, Int2, yes),
            Int1 = [A | I1]
        ;
            format_string_to_ints(As, Bs, Int1, I2, no),
            Int2 = [A | I2]
        )
    ;
        ( A = ('.') ->
            format_string_to_ints( As, Bs, Int1, Int2, no)
        ;
            Bs = [A | As],
            Int1 = [],
            Int2 = []
        )
    ).

:- pred format_int_from_char_list( list(char), int).
:- mode format_int_from_char_list( in, out) is det.
%       Convert a char_list to an int
%
format_int_from_char_list( [], 0).
format_int_from_char_list( [L | Ls], I) :-
    (
        from_char_list( [L | Ls], S),
        to_int( S, I_0)
    ->
        I = I_0
    ;
        I = 0
    ).

:- pred float_abs(float, float).
:- mode float_abs(in, out) is det.
float_abs(Fin, Fout) :-
    ( Fin < 0.0 ->
        Fout = 0.0 - Fin
    ;
        Fout = Fin
    ).

:- pred default_precision_and_width(int).
:- mode default_precision_and_width(out) is det.
default_precision_and_width(-6).

:- pred special_precision_and_width(int).
:- mode special_precision_and_width(out) is det.
special_precision_and_width(-1).

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