%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Test case for the various methods of term construction in the presence
% of arguments packed next to both local and remote secondary tags.
%
% The methods are:
%
% - construct unifications on dynamic data
%   ({ml_,}generate_construction_unification in
%   compiler/{ml_,}unify_gen_construct.m)
%
% - constructions of ground terms
%   ({ml_,}generate_ground_term in compiler/{ml_,}unify_gen_construct.m)
%
% - construct unifications on static data
%   ({ml_,}generate_const_structs} in {ml_,}unify_gen_construct.m)
%
% - construction at runtime
%   (in library/construct.m)
%
% - copying at runtime
%   (in library/builtin.m and in runtime/mercury_deep_copy*)
%
% - field updates (reconstructions)
%   ({ml_,}generate_deconstruction_unification in
%   compiler/{ml_,}unify_gen_deconstruct.m, as well as
%   {ml_,}generate_construction_unification in
%   compiler/{ml_,}unify_gen_construct.m)
%

:- module construct_packed.
:- interface.
:- import_module io.

:- pred main(io::di, io::uo) is det.

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

:- implementation.

:- import_module construct.
:- import_module int.
:- import_module list.
:- import_module string.
:- import_module type_desc.
:- import_module univ.

    % An enum type whose representation takes 1 bit.
:- type flag
    --->    flag_clear
    ;       flag_set.

    % An enum type whose representation takes 2 bits.
:- type color
    --->    red
    ;       green
    ;       blue.

    % An enum type whose representation takes 3 bits.
:- type fruit
    --->    apple
    ;       pear
    ;       peach
    ;       orange
    ;       banana.

    % Every function symbol fN* should be allocated primary tag N.
    % The function symbols whose names end in _[abc] share their
    % primary tags. being distinguished by a local (f0) or remote (f7)
    % secondary tag. These all have an initial sequence of subword-sized
    % arguments that the compiler should pack next to the secondary tag.
:- type t
    --->    f0_a
    ;       f0_b(f0_b1 :: flag, f0_b2 :: color, f0_b3 :: fruit)
    ;       f0_c(f0_c1 :: color, f0_c2 :: fruit, f0_c3 :: flag)
    ;       f1(int)
    ;       f2(int)
    ;       f3(int)
    ;       f4(int)
    ;       f5(int)
    ;       f6(int)
    ;       f7_a(f7_a1 :: int)
    ;       f7_b(f7_b1 :: flag, f7_b2 :: color, f7_b3 :: fruit, f7_b4 :: float)
    ;       f7_c(f7_c1 :: fruit, f7_c2 :: flag, f7_c3 :: color, f7_c4 :: int).

main(!IO) :-
    TypeDesc = type_desc.type_of(f0_a),

    % Test construction of structured terms using each of the three
    % construction methods that have separate code for them in the compiler:
    % dynamic construct unification, static construct unification, and static
    % ground term, as well as using the construct.m library module.

    io.write_string("Construct for terms with packed local sectags\n\n", !IO),

    DynamicLocalA0 =      f0_a,
    ConstructLocalA0 = make_term(TypeDesc, "f0_a", []),
    builtin.copy(DynamicLocalA0, CopyLocalA0),

    io.write_line(DynamicLocalA0, !IO),
    write_univ_line(ConstructLocalA0, !IO),
    io.write_line(CopyLocalA0, !IO),
    io.nl(!IO),

    DynamicLocalB0 =      f0_b(flag_set, blue, id(peach)),
    StaticLocalB0 =       f0_b(flag_set, blue, peach),
    GroundTermsLocalB0 = [f0_b(flag_set, blue, peach),
                          f0_b(flag_set, blue, peach),
                          f0_b(flag_set, blue, peach),
                          f0_b(flag_set, blue, peach),
 
                          f0_b(flag_set, blue, peach),
                          f0_b(flag_set, blue, peach),
                          f0_b(flag_set, blue, peach),
                          f0_b(flag_set, blue, peach)],
    list.det_head(GroundTermsLocalB0, GroundTermLocalB0),
    ConstructLocalB0 = make_term(TypeDesc, "f0_b",
        [univ(flag_set), univ(blue), univ(peach)]),
    builtin.copy(DynamicLocalB0, CopyLocalB0),

    io.write_line(DynamicLocalB0, !IO),
    io.write_line(StaticLocalB0, !IO),
    io.write_line(GroundTermLocalB0, !IO),
    write_univ_line(ConstructLocalB0, !IO),
    io.write_line(CopyLocalB0, !IO),
    io.nl(!IO),

    DynamicLocalC0 =      f0_c(green, orange, id(flag_clear)),
    StaticLocalC0 =       f0_c(green, orange, flag_clear),
    GroundTermsLocalC0 = [f0_c(green, orange, flag_clear),
                          f0_c(green, orange, flag_clear),
                          f0_c(green, orange, flag_clear),
                          f0_c(green, orange, flag_clear),
 
                          f0_c(green, orange, flag_clear),
                          f0_c(green, orange, flag_clear),
                          f0_c(green, orange, flag_clear),
                          f0_c(green, orange, flag_clear)],
    list.det_head(GroundTermsLocalC0, GroundTermLocalC0),
    ConstructLocalC0 = make_term(TypeDesc, "f0_c",
        [univ(green), univ(orange), univ(flag_clear)]),
    builtin.copy(DynamicLocalC0, CopyLocalC0),

    io.write_line(DynamicLocalC0, !IO),
    io.write_line(StaticLocalC0, !IO),
    io.write_line(GroundTermLocalC0, !IO),
    write_univ_line(ConstructLocalC0, !IO),
    io.write_line(CopyLocalC0, !IO),
    io.nl(!IO),

    io.write_string("Reconstruct for terms with packed local sectags\n\n",
        !IO),
    DynamicLocalB1 = DynamicLocalB0 ^ f0_b1 := flag_clear,
    DynamicLocalB2 = DynamicLocalB1 ^ f0_b2 := red,
    DynamicLocalB3 = DynamicLocalB2 ^ f0_b3 := orange,
    DynamicLocalC1 = DynamicLocalC0 ^ f0_c1 := blue,
    DynamicLocalC2 = DynamicLocalC1 ^ f0_c2 := pear,
    DynamicLocalC3 = DynamicLocalC2 ^ f0_c3 := flag_set,

    io.write_line(DynamicLocalB1, !IO),
    io.write_line(DynamicLocalB2, !IO),
    io.write_line(DynamicLocalB3, !IO),
    io.write_line(DynamicLocalC1, !IO),
    io.write_line(DynamicLocalC2, !IO),
    io.write_line(DynamicLocalC3, !IO),
    io.nl(!IO),

    io.write_string("Construct for terms with packed remote sectags\n\n", !IO),
    DynamicRemoteA0 =      f7_a(id(41)),
    StaticRemoteA0 =       f7_a(41),
    GroundTermsRemoteA0 = [f7_a(41), f7_a(41), f7_a(41), f7_a(41),
                           f7_a(41), f7_a(41), f7_a(41), f7_a(41),
                           f7_a(41), f7_a(41), f7_a(41), f7_a(41),
                           f7_a(41), f7_a(41), f7_a(41), f7_a(41),

                           f7_a(41), f7_a(41), f7_a(41), f7_a(41),
                           f7_a(41), f7_a(41), f7_a(41), f7_a(41),
                           f7_a(41), f7_a(41), f7_a(41), f7_a(41),
                           f7_a(41), f7_a(41), f7_a(41), f7_a(41)],
    list.det_head(GroundTermsRemoteA0, GroundTermRemoteA0),
    ConstructRemoteA0 = make_term(TypeDesc, "f7_a", [univ(41)]),
    builtin.copy(DynamicRemoteA0, CopyRemoteA0),

    io.write_line(DynamicRemoteA0, !IO),
    io.write_line(StaticRemoteA0, !IO),
    io.write_line(GroundTermRemoteA0, !IO),
    write_univ_line(ConstructRemoteA0, !IO),
    io.write_line(CopyRemoteA0, !IO),
    io.nl(!IO),

    DynamicRemoteB0 =      f7_b(flag_clear, red, id(peach), 98.7),
    StaticRemoteB0 =       f7_b(flag_clear, red, peach, 98.7),
    GroundTermsRemoteB0 = [f7_b(flag_clear, red, peach, 98.7),
                           f7_b(flag_clear, red, peach, 98.7),
                           f7_b(flag_clear, red, peach, 98.7),
                           f7_b(flag_clear, red, peach, 98.7),

                           f7_b(flag_clear, red, peach, 98.7),
                           f7_b(flag_clear, red, peach, 98.7),
                           f7_b(flag_clear, red, peach, 98.7),
                           f7_b(flag_clear, red, peach, 98.7)],
    list.det_head(GroundTermsRemoteB0, GroundTermRemoteB0),
    ConstructRemoteB0 = make_term(TypeDesc, "f7_b",
        [univ(flag_clear), univ(red), univ(peach), univ(98.7)]),
    builtin.copy(DynamicRemoteB0, CopyRemoteB0),

    io.write_line(DynamicRemoteB0, !IO),
    io.write_line(StaticRemoteB0, !IO),
    io.write_line(GroundTermRemoteB0, !IO),
    write_univ_line(ConstructRemoteB0, !IO),
    io.write_line(CopyRemoteB0, !IO),
    io.nl(!IO),

    DynamicRemoteC0 =      f7_c(pear, flag_set, green, id(43)),
    StaticRemoteC0 =       f7_c(pear, flag_set, green, 43),
    GroundTermsRemoteC0 = [f7_c(pear, flag_set, green, 43),
                           f7_c(pear, flag_set, green, 43),
                           f7_c(pear, flag_set, green, 43),
                           f7_c(pear, flag_set, green, 43),

                           f7_c(pear, flag_set, green, 43),
                           f7_c(pear, flag_set, green, 43),
                           f7_c(pear, flag_set, green, 43),
                           f7_c(pear, flag_set, green, 43)],
    list.det_head(GroundTermsRemoteC0, GroundTermRemoteC0),
    ConstructRemoteC0 = make_term(TypeDesc, "f7_c",
        [univ(pear), univ(flag_set), univ(green), univ(43)]),
    builtin.copy(DynamicRemoteC0, CopyRemoteC0),

    io.write_line(DynamicRemoteC0, !IO),
    io.write_line(StaticRemoteC0, !IO),
    io.write_line(GroundTermRemoteC0, !IO),
    write_univ_line(ConstructRemoteC0, !IO),
    io.write_line(CopyRemoteC0, !IO),
    io.nl(!IO),

    io.write_string("Reconstruct for terms with packed remote sectags\n\n",
        !IO),

    DynamicRemoteA1 = DynamicRemoteA0 ^ f7_a1 := 51,
    DynamicRemoteB1 = DynamicRemoteB0 ^ f7_b1 := flag_set,
    DynamicRemoteB2 = DynamicRemoteB1 ^ f7_b2 := blue,
    DynamicRemoteB3 = DynamicRemoteB2 ^ f7_b3 := orange,
    DynamicRemoteB4 = DynamicRemoteB3 ^ f7_b4 := 87.6,
    DynamicRemoteC1 = DynamicRemoteC0 ^ f7_c1 := apple,
    DynamicRemoteC2 = DynamicRemoteC1 ^ f7_c2 := flag_clear,
    DynamicRemoteC3 = DynamicRemoteC2 ^ f7_c3 := blue,
    DynamicRemoteC4 = DynamicRemoteC3 ^ f7_c4 := 53,

    io.write_line(DynamicRemoteA1, !IO),
    io.write_line(DynamicRemoteB1, !IO),
    io.write_line(DynamicRemoteB2, !IO),
    io.write_line(DynamicRemoteB3, !IO),
    io.write_line(DynamicRemoteB4, !IO),
    io.write_line(DynamicRemoteC1, !IO),
    io.write_line(DynamicRemoteC2, !IO),
    io.write_line(DynamicRemoteC3, !IO),
    io.write_line(DynamicRemoteC4, !IO).

:- func id(T) = T.
:- pragma no_inline(id/1).

id(N) = N.

:- func make_term(type_desc, string, list(univ)) = univ is det.

make_term(TypeDesc, Functor, ArgUnivs) = TermUniv :-
    list.length(ArgUnivs, Arity),
    ( if
        find_functor(TypeDesc, Functor, Arity, Lex, _ArgTypeDescs),
        construct(TypeDesc, Lex, ArgUnivs, TermUnivPrime)
    then
        TermUniv = TermUnivPrime
    else
        TermUniv = univ("construct failed")
    ).

:- pred write_univ_line(univ::in, io::di, io::uo) is det.

write_univ_line(Univ, !IO) :-
    ( if univ_to_type(Univ, T : t) then
        io.write_line(T, !IO)
    else if univ_to_type(Univ, S : string) then
        io.write_string(S, !IO),
        io.nl(!IO)
    else
        io.write_string("unexpected kind of univ", !IO)
    ).
