// vim: ts=4 sw=4 expandtab ft=c

// Copyright (C) 2002-2007, 2011 The University of Melbourne.
// Copyright (C) 2013-2018 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.

// mercury_deconstruct.c
//
// This file provides utility functions for deconstructing terms, for use by
// the standard library.

#include "mercury_imp.h"
#include "mercury_deconstruct.h"
#include "mercury_deconstruct_macros.h"
#include "mercury_type_desc.h"
#include "mercury_minimal_model.h"

// We reserve a buffer to hold the names we dynamically generate
// for "functors" of foreign types. This macro gives its size.

#define MR_FOREIGN_NAME_BUF_SIZE    256

static  MR_ConstString  MR_expand_type_name(MR_TypeCtorInfo tci, MR_bool);

#define EXPAND_FUNCTION_NAME        MR_expand_functor_args
#define EXPAND_TYPE_NAME            MR_ExpandFunctorArgsInfo
#define EXPAND_FUNCTOR_FIELD        functor
#define EXPAND_ARGS_FIELD           args
#include "mercury_ml_expand_body.h"
#undef  EXPAND_FUNCTION_NAME
#undef  EXPAND_TYPE_NAME
#undef  EXPAND_FUNCTOR_FIELD
#undef  EXPAND_ARGS_FIELD

#define EXPAND_FUNCTION_NAME        MR_expand_functor_args_limit
#define EXPAND_TYPE_NAME            MR_ExpandFunctorArgsLimitInfo
#define EXPAND_FUNCTOR_FIELD        functor
#define EXPAND_ARGS_FIELD           args
#define EXPAND_APPLY_LIMIT
#include "mercury_ml_expand_body.h"
#undef  EXPAND_FUNCTION_NAME
#undef  EXPAND_TYPE_NAME
#undef  EXPAND_FUNCTOR_FIELD
#undef  EXPAND_ARGS_FIELD
#undef  EXPAND_APPLY_LIMIT

#define EXPAND_FUNCTION_NAME        MR_expand_functor_only
#define EXPAND_TYPE_NAME            MR_ExpandFunctorOnlyInfo
#define EXPAND_FUNCTOR_FIELD        functor_only
#include "mercury_ml_expand_body.h"
#undef  EXPAND_FUNCTION_NAME
#undef  EXPAND_TYPE_NAME
#undef  EXPAND_FUNCTOR_FIELD

#define EXPAND_FUNCTION_NAME        MR_expand_args_only
#define EXPAND_TYPE_NAME            MR_ExpandArgsOnlyInfo
#define EXPAND_ARGS_FIELD           args_only
#include "mercury_ml_expand_body.h"
#undef  EXPAND_FUNCTION_NAME
#undef  EXPAND_TYPE_NAME
#undef  EXPAND_ARGS_FIELD

#define EXPAND_FUNCTION_NAME        MR_expand_chosen_arg_only
#define EXPAND_TYPE_NAME            MR_ExpandChosenArgOnlyInfo
#define EXPAND_CHOSEN_ARG
#include "mercury_ml_expand_body.h"
#undef  EXPAND_FUNCTION_NAME
#undef  EXPAND_TYPE_NAME
#undef  EXPAND_CHOSEN_ARG

#define EXPAND_FUNCTION_NAME        MR_expand_named_arg_only
#define EXPAND_TYPE_NAME            MR_ExpandChosenArgOnlyInfo
#define EXPAND_NAMED_ARG
#include "mercury_ml_expand_body.h"
#undef  EXPAND_FUNCTION_NAME
#undef  EXPAND_TYPE_NAME
#undef  EXPAND_NAMED_ARG

// N.B. any modifications to the signature of this function will require
// changes not only to library/deconstruct.m, but also to library/store.m
// and extras/trailed_update/tr_store.m.

MR_bool
MR_arg(MR_TypeInfo type_info, MR_Word *term_ptr, int arg_index,
    MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr,
    const MR_DuArgLocn **arg_locn_ptr, MR_noncanon_handling noncanon)
{
    MR_ExpandChosenArgOnlyInfo  expand_info;

    MR_expand_chosen_arg_only(type_info, term_ptr, noncanon, arg_index,
        &expand_info);

    // Check range.
    if (expand_info.chosen_index_exists) {
        *arg_type_info_ptr = expand_info.chosen_type_info;
        *arg_ptr = expand_info.chosen_value_ptr;
        *arg_locn_ptr = expand_info.chosen_arg_locn;
        return MR_TRUE;
    }

    return MR_FALSE;
}

MR_bool
MR_named_arg(MR_TypeInfo type_info, MR_Word *term_ptr, MR_ConstString arg_name,
    MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr,
    const MR_DuArgLocn **arg_locn_ptr, MR_noncanon_handling noncanon)
{
    MR_ExpandChosenArgOnlyInfo  expand_info;

    MR_expand_named_arg_only(type_info, term_ptr, noncanon, arg_name,
        &expand_info);

    // Check range.
    if (expand_info.chosen_index_exists) {
        *arg_type_info_ptr = expand_info.chosen_type_info;
        *arg_ptr = expand_info.chosen_value_ptr;
        *arg_locn_ptr = expand_info.chosen_arg_locn;
        return MR_TRUE;
    }

    return MR_FALSE;
}

MR_bool
MR_named_arg_num(MR_TypeInfo type_info, MR_Word *term_ptr,
    const char *arg_name, int *arg_num_ptr)
{
    MR_TypeCtorInfo             type_ctor_info;
    MR_DuTypeLayout             du_type_layout;
    const MR_DuPtagLayout       *ptag_layout;
    const MR_DuFunctorDesc      *functor_desc;
    const MR_NotagFunctorDesc   *notag_functor_desc;
    MR_Word                     data;
    int                         ptag;
    MR_Word                     sectag;
    MR_TypeInfo                 eqv_type_info;
    int                         i;

    type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);

    if (! MR_type_ctor_has_valid_rep(type_ctor_info)) {
        MR_fatal_error("MR_named_arg_num: term of unknown representation");
    }

    switch (MR_type_ctor_rep(type_ctor_info)) {
        case MR_TYPECTOR_REP_DU_USEREQ:
        case MR_TYPECTOR_REP_DU:
            data = *term_ptr;
            du_type_layout = MR_type_ctor_layout(type_ctor_info).MR_layout_du;
            ptag = MR_tag(data);
            ptag_layout = &du_type_layout[ptag];

            switch (ptag_layout->MR_sectag_locn) {
                case MR_SECTAG_NONE:
                case MR_SECTAG_NONE_DIRECT_ARG:
                    functor_desc = ptag_layout->MR_sectag_alternatives[0];
                    break;
                case MR_SECTAG_LOCAL_REST_OF_WORD:
                    sectag = MR_unmkbody(data);
                    functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
                    break;
                case MR_SECTAG_LOCAL_BITS:
                    sectag = MR_unmkbody(data) &
                        ((1 << ptag_layout->MR_sectag_numbits) - 1);
                    functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
                    break;
                case MR_SECTAG_REMOTE:
                    sectag = MR_field(ptag, data, 0);
                    functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
                    break;
                case MR_SECTAG_VARIABLE:
                    MR_fatal_error("MR_named_arg_num(): unexpected variable");
                default:
                    MR_fatal_error("MR_named_arg_num(): invalid sectag_locn");
            }

            if (functor_desc->MR_du_functor_arg_names == NULL) {
                return MR_FALSE;
            }

            for (i = 0; i < functor_desc->MR_du_functor_orig_arity; i++) {
                if (functor_desc->MR_du_functor_arg_names[i] != NULL
                && MR_streq(arg_name,
                    functor_desc->MR_du_functor_arg_names[i]))
                {
                    *arg_num_ptr = i;
                    return MR_TRUE;
                }
            }

            return MR_FALSE;

        case MR_TYPECTOR_REP_EQUIV:
            eqv_type_info = MR_create_type_info(
                MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
                MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
            return MR_named_arg_num(eqv_type_info, term_ptr, arg_name,
                arg_num_ptr);

        case MR_TYPECTOR_REP_EQUIV_GROUND:
            eqv_type_info = MR_pseudo_type_info_is_ground(
                MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
            return MR_named_arg_num(eqv_type_info, term_ptr, arg_name,
                arg_num_ptr);

        case MR_TYPECTOR_REP_NOTAG:
        case MR_TYPECTOR_REP_NOTAG_USEREQ:
        case MR_TYPECTOR_REP_NOTAG_GROUND:
        case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
            notag_functor_desc = MR_type_ctor_functors(type_ctor_info).
                MR_functors_notag;

            if (notag_functor_desc->MR_notag_functor_arg_name != NULL
            && MR_streq(arg_name,
                notag_functor_desc->MR_notag_functor_arg_name))
            {
                *arg_num_ptr = 0;
                return MR_TRUE;
            }

            return MR_FALSE;

        case MR_TYPECTOR_REP_ENUM:
        case MR_TYPECTOR_REP_ENUM_USEREQ:
        case MR_TYPECTOR_REP_DUMMY:
        case MR_TYPECTOR_REP_INT:
        case MR_TYPECTOR_REP_UINT:
        case MR_TYPECTOR_REP_INT8:
        case MR_TYPECTOR_REP_UINT8:
        case MR_TYPECTOR_REP_INT16:
        case MR_TYPECTOR_REP_UINT16:
        case MR_TYPECTOR_REP_INT32:
        case MR_TYPECTOR_REP_UINT32:
        case MR_TYPECTOR_REP_INT64:
        case MR_TYPECTOR_REP_UINT64:
        case MR_TYPECTOR_REP_FLOAT:
        case MR_TYPECTOR_REP_CHAR:
        case MR_TYPECTOR_REP_STRING:
        case MR_TYPECTOR_REP_BITMAP:
        case MR_TYPECTOR_REP_FUNC:
        case MR_TYPECTOR_REP_PRED:
        case MR_TYPECTOR_REP_SUBGOAL:
        case MR_TYPECTOR_REP_VOID:
        case MR_TYPECTOR_REP_C_POINTER:
        case MR_TYPECTOR_REP_STABLE_C_POINTER:
        case MR_TYPECTOR_REP_TYPEINFO:
        case MR_TYPECTOR_REP_TYPECTORINFO:
        case MR_TYPECTOR_REP_TYPEDESC:
        case MR_TYPECTOR_REP_TYPECTORDESC:
        case MR_TYPECTOR_REP_PSEUDOTYPEDESC:
        case MR_TYPECTOR_REP_TYPECLASSINFO:
        case MR_TYPECTOR_REP_BASETYPECLASSINFO:
        case MR_TYPECTOR_REP_SUCCIP:
        case MR_TYPECTOR_REP_HP:
        case MR_TYPECTOR_REP_CURFR:
        case MR_TYPECTOR_REP_MAXFR:
        case MR_TYPECTOR_REP_REDOFR:
        case MR_TYPECTOR_REP_REDOIP:
        case MR_TYPECTOR_REP_TICKET:
        case MR_TYPECTOR_REP_TRAIL_PTR:
        case MR_TYPECTOR_REP_REFERENCE:
        case MR_TYPECTOR_REP_TUPLE:
        case MR_TYPECTOR_REP_ARRAY:
        case MR_TYPECTOR_REP_FOREIGN:
        case MR_TYPECTOR_REP_STABLE_FOREIGN:
        case MR_TYPECTOR_REP_FOREIGN_ENUM:
        case MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ:
        case MR_TYPECTOR_REP_UNUSED1:
        case MR_TYPECTOR_REP_UNUSED2:
        case MR_TYPECTOR_REP_UNKNOWN:
            return MR_FALSE;
    }

    MR_fatal_error("MR_named_arg_num: unexpected fallthrough");
}

static MR_ConstString
MR_expand_type_name(MR_TypeCtorInfo tci, MR_bool wrap)
{
    MR_String   str;
    int         len;

    len = 0;
    len += strlen(tci->MR_type_ctor_module_name);
    len += 1;   // '.'
    len += strlen(tci->MR_type_ctor_name);
    len += 1;   // '/'
    len += 4;   // arity; we do not support arities above 1024
    if (wrap) {
        len += 4;   // <<>>
    }
    len += 1;   // NULL

    if (tci->MR_type_ctor_arity > 9999) {
        MR_fatal_error("MR_expand_type_name: arity > 9999");
    }

    MR_restore_transient_hp();
    MR_allocate_aligned_string_msg(str, len, MR_ALLOC_SITE_STRING);
    MR_save_transient_hp();

    sprintf(str, wrap? "<<%s.%s/%d>>" : "%s.%s/%d",
        tci->MR_type_ctor_module_name,
        tci->MR_type_ctor_name,
        (int) tci->MR_type_ctor_arity);

    return (MR_ConstString) str;
}

MR_Word
MR_arg_value_uncommon(MR_Word *arg_ptr, const MR_DuArgLocn *arg_locn)
{
    MR_Word     val;

    // The meanings of the various special values of MR_arg_bits
    // are documented next to the definition of the MR_DuArgLocn type
    // in mercury_type_info.h.

    switch (arg_locn->MR_arg_bits) {

    case -1:
        // MR_arg_bits == -1 means the argument is a double-precision
        // floating point value occupying two words.
#ifdef MR_BOXED_FLOAT
        {
            MR_Float    flt;
            flt = MR_float_from_dword(arg_ptr[0], arg_ptr[1]);

    #ifdef MR_HIGHLEVEL_CODE
            return (MR_Word) MR_box_float(flt);
    #else
            return MR_float_to_word(flt);
    #endif
        }
#else
        MR_fatal_error("double-word floats should not exist in this grade");
#endif

    case -2:
        // MR_arg_bits == -2 means the argument is an int64 value
        // occupying two words.
#if defined(MR_BOXED_INT64S)
        {
            int64_t     i64;
            i64 = MR_int64_from_dword(arg_ptr[0], arg_ptr[1]);

    #ifdef MR_HIGHLEVEL_CODE
            return (MR_Word) MR_box_int64(i64);
    #else
            return MR_int64_to_word(i64);
    #endif
        }
#else
        MR_fatal_error("double-word int64s should not exist in this grade");
#endif

    case -3:
        // MR_arg_bits == -3 means the argument is a uint64 value
        // occupying two words.
#if defined(MR_BOXED_INT64S)
        {
            uint64_t     ui64;
            ui64 = MR_uint64_from_dword(arg_ptr[0], arg_ptr[1]);

    #ifdef MR_HIGHLEVEL_CODE
            return (MR_Word) MR_box_uint64(ui64);
    #else
            return MR_uint64_to_word(ui64);
    #endif
        }
#else
        MR_fatal_error("double-word uint64s should not exist in this grade");
#endif

    case -4:
        // MR_arg_bits == -4 means the argument is an int8 value
        // occupying part of one word.
        val = *arg_ptr;
        val = (val >> arg_locn->MR_arg_shift) & ((MR_Word) 0xff);
        val = (MR_Word) (int8_t) val;
        return val;

    case -5:
        // MR_arg_bits == -5 means the argument is a uint8 value
        // occupying part of one word.
        val = *arg_ptr;
        val = (val >> arg_locn->MR_arg_shift) & ((MR_Word) 0xff);
        val = (MR_Word) (uint8_t) val;
        return val;

    case -6:
        // MR_arg_bits == -6 means the argument is an int16 value
        // occupying part of one word.
        val = *arg_ptr;
        val = (val >> arg_locn->MR_arg_shift) & ((MR_Word) 0xffff);
        val = (MR_Word) (int16_t) val;
        return val;

    case -7:
        // MR_arg_bits == -7 means the argument is a uint16 value
        // occupying part of one word.
        val = *arg_ptr;
        val = (val >> arg_locn->MR_arg_shift) & ((MR_Word) 0xffff);
        val = (MR_Word) (uint16_t) val;
        return val;

    case -8:
        // MR_arg_bits == -8 means the argument is an int32 value
        // occupying part of one word.
        val = *arg_ptr;
        val = (val >> arg_locn->MR_arg_shift) & ((MR_Word) 0xffffffff);
        val = (MR_Word) (int32_t) val;
        return val;

    case -9:
        // MR_arg_bits == -9 means the argument is a uint32 value
        // occupying part of one word.
        val = *arg_ptr;
        val = (val >> arg_locn->MR_arg_shift) & ((MR_Word) 0xffffffff);
        val = (MR_Word) (uint32_t) val;
        return val;

    case -10:
        // MR_arg_bits == -10 means the argument is of a dummy type.
        return 0;

    default:
        if (arg_locn->MR_arg_bits > 0) {
            // The argument is a packed enumeration value.
            val = *arg_ptr;
            val = (val >> arg_locn->MR_arg_shift)
                & ((MR_Word) (1 << arg_locn->MR_arg_bits) - 1);
            return val;
        } else {
            // If MR_arg_bits is exactly zero, this function
            // should not have been called at all (since that is
            // the *common* case).
            MR_fatal_error("unexpected value of MR_arg_bits");
        }
    }
}