%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1999-2012, 2014 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%

:- module ml_backend.ml_unify_gen_test.
:- interface.

:- import_module hlds.
:- import_module hlds.hlds_data.
:- import_module ml_backend.ml_gen_info.
:- import_module ml_backend.mlds.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.

:- import_module list.

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

    % ml_generate_test_var_has_cons_id(Var, ConsId, TestRval, !Info):
    %
    % We generate the boolean rval TestRval, which will evaluate to true
    % iff Var has the functor specified by ConsId.
    %
:- pred ml_generate_test_var_has_cons_id(prog_var::in, cons_id::in,
    mlds_rval::out, ml_gen_info::in, ml_gen_info::out) is det.

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

    % ml_generate_test_var_has_tagged_cons_id(Var,
    %   MainTaggedConsId, OtherTaggedConsIds, TestRval, !Info):
    %
    % We generate the boolean rval TestRval, which will evaluate to true
    % iff Var's functor is one of those specified by MainTaggedConsId
    % or OtherTaggedConsIds.
    %
    % Exported for use by ml_switch_gen.m.
    %
:- pred ml_generate_test_var_has_one_tagged_cons_id(prog_var::in,
    tagged_cons_id::in, list(tagged_cons_id)::in, mlds_rval::out,
    ml_gen_info::in, ml_gen_info::out) is det.

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

:- implementation.

:- import_module backend_libs.
:- import_module backend_libs.builtin_ops.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module libs.
:- import_module libs.globals.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module ml_backend.ml_code_util.
:- import_module ml_backend.ml_unify_gen_util.
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.var_table.

:- import_module maybe.
:- import_module require.
:- import_module term.
:- import_module uint.
:- import_module uint8.

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

ml_generate_test_var_has_cons_id(Var, ConsId, TestRval, !Info) :-
    % NOTE: Keep in sync with ml_generate_test_var_has_one_tagged_cons_id
    % below.
    ml_gen_info_get_var_table(!.Info, VarTable),
    lookup_var_entry(VarTable, Var, VarEntry),
    VarType = VarEntry ^ vte_type,
    ml_gen_var(!.Info, Var, VarEntry, VarLval),
    VarRval = ml_lval(VarLval),
    ml_cons_id_to_tag(!.Info, ConsId, ConsTag),
    ml_get_maybe_cheaper_tag_test(!.Info, VarType, CheaperTagTest),
    ml_generate_test_rval_has_cons_tag(!.Info, VarRval, VarType,
        CheaperTagTest, ConsTag, TestRval).

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

ml_generate_test_var_has_one_tagged_cons_id(Var,
        MainTaggedConsId, OtherTaggedConsIds, TestRval, !Info) :-
    % NOTE: Keep in sync with ml_generate_test_var_has_cons_id above.
    ml_gen_info_get_var_table(!.Info, VarTable),
    lookup_var_entry(VarTable, Var, VarEntry),
    VarType = VarEntry ^ vte_type,
    ml_gen_var(!.Info, Var, VarEntry, VarLval),
    VarRval = ml_lval(VarLval),
    ml_get_maybe_cheaper_tag_test(!.Info, VarType, CheaperTagTest),

    ml_generate_test_rval_has_tagged_cons_id(!.Info, VarRval, VarType,
        CheaperTagTest, MainTaggedConsId, MainTestRval),
    list.map(
        ml_generate_test_rval_has_tagged_cons_id(!.Info, VarRval, VarType,
            CheaperTagTest),
        OtherTaggedConsIds, OtherTestRvals),
    ml_logical_or_rvals(MainTestRval, OtherTestRvals, TestRval).

    % logical_or_rvals(FirstRval, LaterRvals, Rval):
    %
    % Rval is true iff any one of FirstRval and LaterRvals is true.
    %
:- pred ml_logical_or_rvals(mlds_rval::in, list(mlds_rval)::in, mlds_rval::out)
    is det.

ml_logical_or_rvals(FirstRval, LaterRvals, Rval) :-
    (
        LaterRvals = [],
        Rval = FirstRval
    ;
        LaterRvals = [SecondRval | OtherRvals],
        FirstSecondRval = ml_binop(logical_or, FirstRval, SecondRval),
        ml_logical_or_rvals(FirstSecondRval, OtherRvals, Rval)
    ).

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

:- pred ml_generate_test_rval_has_tagged_cons_id(ml_gen_info::in,
    mlds_rval::in, mer_type::in, maybe_cheaper_tag_test::in,
    tagged_cons_id::in, mlds_rval::out) is det.

ml_generate_test_rval_has_tagged_cons_id(Info, Rval, Type, CheaperTagTest,
        TaggedConsId, TestRval) :-
    TaggedConsId = tagged_cons_id(_ConsId, ConsTag),
    ml_generate_test_rval_has_cons_tag(Info, Rval, Type, CheaperTagTest,
        ConsTag, TestRval).

    % ml_generate_test_rval_has_cons_tag(Info, VarRval, VarType, ConsTag,
    %   TestRval):
    %
    % TestRval is an rval of type bool which evaluates to true if VarRval,
    % which has type VarType, has the specified ConsTag, and false otherwise.
    %
:- pred ml_generate_test_rval_has_cons_tag(ml_gen_info::in,
    mlds_rval::in, mer_type::in, maybe_cheaper_tag_test::in, cons_tag::in,
    mlds_rval::out) is det.

ml_generate_test_rval_has_cons_tag(Info, VarRval, VarType, CheaperTagTest,
        ConsTag, TestRval) :-
    ( if
        CheaperTagTest = cheaper_tag_test(_ExpensiveConsId, ExpensiveConsTag,
            _CheapConsId, CheapConsTag),
        ConsTag = ExpensiveConsTag
    then
        ml_generate_test_rval_has_cons_tag_direct(Info, VarRval, VarType,
            CheapConsTag, CheapConsTagTestRval),
        ( if
            CheapConsTagTestRval =
                ml_binop(int_cmp(IntType, eq), SubRvalA, SubRvalB)
        then
            TestRval = ml_binop(int_cmp(IntType, ne), SubRvalA, SubRvalB)
        else
            TestRval = ml_unop(logical_not, CheapConsTagTestRval)
        )
    else
        ml_generate_test_rval_has_cons_tag_direct(Info, VarRval, VarType,
            ConsTag, TestRval)
    ).

:- pred ml_generate_test_rval_has_cons_tag_direct(ml_gen_info::in,
    mlds_rval::in, mer_type::in, cons_tag::in, mlds_rval::out) is det.

ml_generate_test_rval_has_cons_tag_direct(Info, VarRval, Type,
        ConsTag, TestRval) :-
    (
        ConsTag = int_tag(IntTag),
        ml_gen_info_get_module_info(Info, ModuleInfo),
        ml_generate_test_rval_is_int_tag(ModuleInfo, VarRval, Type, IntTag,
            TestRval)
    ;
        ConsTag = float_tag(Float),
        TestRval = ml_binop(float_cmp(eq),
            VarRval, ml_const(mlconst_float(Float)))
    ;
        ConsTag = string_tag(String),
        TestRval = ml_binop(str_cmp(eq),
            VarRval, ml_const(mlconst_string(String)))
    ;
        ConsTag = foreign_tag(ForeignLang, ForeignVal),
        ml_gen_info_get_module_info(Info, ModuleInfo),
        MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
        TestRval = ml_binop(int_cmp(int_type_int, eq), VarRval,
            ml_const(mlconst_foreign(ForeignLang, ForeignVal, MLDS_Type)))
    ;
        ( ConsTag = dummy_tag
        ; ConsTag = no_tag
        ),
        % In a type with only one cons_id, all vars have that one cons_id.
        TestRval = ml_const(mlconst_true)
    ;
        ConsTag = direct_arg_tag(Ptag),
        VarPtag = ml_unop(tag, VarRval),
        Ptag = ptag(PtagUint8),
        % XXX ARG_PACK We should get the tag unop to return an unsigned int,
        % to make using an unsigned comparison here simpler.
        PtagConstRval = ml_const(mlconst_int(uint8.cast_to_int(PtagUint8))),
        TestRval = ml_binop(int_cmp(int_type_int, eq), VarPtag, PtagConstRval)
    ;
        ConsTag = remote_args_tag(RemoteArgsTagInfo),
        (
            RemoteArgsTagInfo = remote_args_only_functor,
            % In a type with only one cons_id, all vars have that one cons_id.
            TestRval = ml_const(mlconst_true)
        ;
            RemoteArgsTagInfo = remote_args_unshared(Ptag),
            VarPtag = ml_unop(tag, VarRval),
            Ptag = ptag(PtagUint8),
            PtagConstRval =
                ml_const(mlconst_int(uint8.cast_to_int(PtagUint8))),
            TestRval = ml_binop(int_cmp(int_type_int, eq),
                VarPtag, PtagConstRval)
        ;
            RemoteArgsTagInfo = remote_args_shared(Ptag, RemoteSectag),
            VarPtag = ml_unop(tag, VarRval),
            Ptag = ptag(PtagUint8),
            ConstPtagRval =
                ml_const(mlconst_int(uint8.cast_to_int(PtagUint8))),
            PtagTestRval = ml_binop(int_cmp(int_type_int, eq),
                VarPtag, ConstPtagRval),
            ml_gen_secondary_tag_rval(Info, Type, VarRval, Ptag,
                VarSectagWordRval),
            RemoteSectag = remote_sectag(SectagUint, SectagSize),
            (
                SectagSize = rsectag_word,
                VarSectagRval = VarSectagWordRval
            ;
                SectagSize = rsectag_subword(SectagBits),
                SectagBits = sectag_bits(_NumSectagBits, SectagMask),
                VarSectagRval = ml_binop(bitwise_and(int_type_uint),
                    VarSectagWordRval, ml_const(mlconst_uint(SectagMask)))
            ),
            ConstSectagRval =
                ml_const(mlconst_int(uint.cast_to_int(SectagUint))),
            SectagTestRval = ml_binop(int_cmp(int_type_int, eq),
                VarSectagRval, ConstSectagRval),
            TestRval = ml_binop(logical_and, PtagTestRval, SectagTestRval)
        ;
            RemoteArgsTagInfo = remote_args_ctor(Data),
            Ptag = ptag(0u8),
            ml_gen_secondary_tag_rval(Info, Type, VarRval, Ptag,
                VarSectagRval),
            ConstSectagRval = ml_const(mlconst_int(uint.cast_to_int(Data))),
            TestRval = ml_binop(int_cmp(int_type_int, eq),
                VarSectagRval, ConstSectagRval)
        )
    ;
        ConsTag = local_args_tag(LocalArgsTagInfo),
        (
            LocalArgsTagInfo = local_args_only_functor,
            % In a type with only one cons_id, all vars have that one cons_id.
            TestRval = ml_const(mlconst_true)
        ;
            LocalArgsTagInfo = local_args_not_only_functor(_Ptag, LocalSectag),
            % We generate the same test as for shared_local_tag_no_args
            % with lsectag_must_be_masked.
            LocalSectag = local_sectag(_Sectag, PrimSec, SectagBits),
            ConstPrimSecRval = ml_const(mlconst_uint(PrimSec)),

            ml_gen_info_get_num_ptag_bits(Info, NumPtagBits),
            SectagBits = sectag_bits(NumSectagBits, _SectagMask),
            NumPtagSectagBits = uint8.cast_to_int(NumPtagBits + NumSectagBits),
            PrimSecMask = (1u << NumPtagSectagBits) - 1u,
            MaskedVarRval = ml_binop(bitwise_and(int_type_uint),
                VarRval, ml_const(mlconst_uint(PrimSecMask))),

            % There is no need for a cast, since the Java backend
            % does not support local secondary tags that must be masked.
            TestRval = ml_binop(int_cmp(int_type_uint, eq),
                MaskedVarRval, ConstPrimSecRval)
        )
    ;
        ConsTag = shared_local_tag_no_args(_Ptag, LocalSectag, MustMask),
        LocalSectag = local_sectag(_Sectag, PrimSec, SectagBits),
        ConstPrimSecRval = ml_const(mlconst_uint(PrimSec)),
        (
            MustMask = lsectag_always_rest_of_word,
            ml_gen_info_get_module_info(Info, ModuleInfo),
            MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
            % The cast is needed only by the Java backend.
            TestRval = ml_binop(int_cmp(int_type_int, eq),
                VarRval, ml_cast(MLDS_Type, ConstPrimSecRval))
        ;
            MustMask = lsectag_must_be_masked,
            % We generate the same test as for shared_local_tag_with_args.
            ml_gen_info_get_num_ptag_bits(Info, NumPtagBits),
            SectagBits = sectag_bits(NumSectagBits, _SectagMask),
            NumPtagSectagBits = uint8.cast_to_int(NumPtagBits + NumSectagBits),
            PrimSecMask = (1u << NumPtagSectagBits) - 1u,
            MaskedVarRval = ml_binop(bitwise_and(int_type_uint),
                VarRval, ml_const(mlconst_uint(PrimSecMask))),
            % There is no need for a cast, since the Java backend
            % does not support local secondary tags that must be masked.
            TestRval = ml_binop(int_cmp(int_type_uint, eq),
                MaskedVarRval, ConstPrimSecRval)
        )
    ;
        ( ConsTag = closure_tag(_, _)
        ; ConsTag = type_ctor_info_tag(_, _, _)
        ; ConsTag = base_typeclass_info_tag(_, _, _)
        ; ConsTag = type_info_const_tag(_)
        ; ConsTag = typeclass_info_const_tag(_)
        ; ConsTag = ground_term_const_tag(_, _)
        ; ConsTag = tabling_info_tag(_, _)
        ; ConsTag = deep_profiling_proc_layout_tag(_, _)
        ; ConsTag = table_io_entry_tag(_, _)
        ),
        unexpected($pred, "unexpacted ConsTag")
    ).

:- pred ml_generate_test_rval_is_int_tag(module_info::in, mlds_rval::in,
    mer_type::in, int_tag::in, mlds_rval::out) is det.

ml_generate_test_rval_is_int_tag(ModuleInfo, Rval, Type, IntTag, TestRval) :-
    % Keep this code in sync with ml_int_tag_to_rval_const in ml_code_util.m.
    (
        IntTag = int_tag_int(Int),
        ( if Type = int_type then
            Const = mlconst_int(Int)
        else if Type = char_type then
            Const = mlconst_char(Int)
        else
            MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
            Const = mlconst_enum(Int, MLDS_Type)
        ),
        EqType = int_type_int
    ;
        IntTag = int_tag_uint(UInt),
        EqType = int_type_uint,
        Const = mlconst_uint(UInt)
    ;
        IntTag = int_tag_int8(Int8),
        EqType = int_type_int8,
        Const = mlconst_int8(Int8)
    ;
        IntTag = int_tag_uint8(UInt8),
        EqType = int_type_uint8,
        Const = mlconst_uint8(UInt8)
    ;
        IntTag = int_tag_int16(Int16),
        EqType = int_type_int16,
        Const = mlconst_int16(Int16)
    ;
        IntTag = int_tag_uint16(UInt16),
        EqType = int_type_uint16,
        Const = mlconst_uint16(UInt16)
    ;
        IntTag = int_tag_int32(Int32),
        EqType = int_type_int32,
        Const = mlconst_int32(Int32)
    ;
        IntTag = int_tag_uint32(UInt32),
        EqType = int_type_uint32,
        Const = mlconst_uint32(UInt32)
    ;
        IntTag = int_tag_int64(Int64),
        EqType = int_type_int64,
        Const = mlconst_int64(Int64)
    ;
        IntTag = int_tag_uint64(UInt64),
        EqType = int_type_uint64,
        Const = mlconst_uint64(UInt64)
    ),
    TestRval = ml_binop(int_cmp(EqType, eq), Rval, ml_const(Const)).

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

:- pred ml_get_maybe_cheaper_tag_test(ml_gen_info::in, mer_type::in,
    maybe_cheaper_tag_test::out) is det.

ml_get_maybe_cheaper_tag_test(Info, Type, CheaperTagTest) :-
    ml_gen_info_get_module_info(Info, ModuleInfo),
    type_to_ctor_det(Type, TypeCtor),
    module_info_get_type_table(ModuleInfo, TypeTable),
    ( if
        search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
        get_type_defn_body(TypeDefn, TypeBody),
        TypeBody = hlds_du_type(type_body_du(_, _, _, MaybeRepn, _)),
        MaybeRepn = yes(Repn)
    then
        CheaperTagTest = Repn ^ dur_cheaper_tag_test
    else
        CheaperTagTest = no_cheaper_tag_test
    ).

%---------------------------------------------------------------------------%
:- end_module ml_backend.ml_unify_gen_test.
%---------------------------------------------------------------------------%
