psyclpc/src/pkg-alists.c

/*---------------------------------------------------------------------------
 * Alist handling functions.
 *
 *---------------------------------------------------------------------------
 * One special application of arrays are alists: associative lists.
 * Alists allow the association of data (single values or tuples) with
 * a key value, which is then used to locate the data in the alist structure.
 *
 * Nowadays the same functionality is offered by mappings in a much more
 * efficient manner, so this usage of alists is deprecated. However, for
 * reasons explained below, alists can be used as an efficient way to
 * construct lookup arrays.
 *
 * It might be historically interesting to know that the very first
 * implementations of mappings were mere syntactic sugar for alists.
 * Furthermore, the LPMud variant of alists offers only a part of the
 * functionality of 'real' alists.
 *
 * Alists are implemented by a vector of vectors. A typical alist
 * for (key:data1,...,dataN) tuples looks like this:
 *
 *   alist = ({ ({ key values })
 *            , ({ data1 values })
 *            , ...
 *            , ({ dataN values })
 *           })
 *
 * All subarrays are of the same length, and all the values for one tuple
 * is found at the same index. For example, if the key for a tuple
 * is found in alist[0][3], the data values are found in alist[1..N][3].
 *
 * The key value array is sorted to allow fast lookups, the sorting order
 * uses the internal representation of the key values (which usually has
 * nothing in common with the meaning of the key values). Three things
 * however can be guaranteed:
 *
 *   - integer key values appear in rising order in the key array, though
 *     not necessarily consecutive.
 *   - removing one or more keys does not break the order of the
 *     other keys.
 *   - all strings used as key values are made shared strings.
 *---------------------------------------------------------------------------
 */

#include "driver.h"
#include "typedefs.h"

#ifdef USE_ALISTS

#include "pkg-alists.h"

#include "my-alloca.h"
#include <stddef.h>

#include "array.h"
#include "interpret.h" /* destructed_object_ref(), error functions */
#include "main.h"
#include "mstrings.h"
#include "simulate.h"  /* errorf() */
#include "svalue.h"
#include "xalloc.h"

#include "i-svalue_cmp.h"

/*-------------------------------------------------------------------------*/
static vector_t *
intersect_ordered_arr (vector_t *a1, vector_t *a2)

/* Compute the intersection of the two ordered arrays <a1> and <a2>.
 *
 * The result is a new sorted(!) vector with all elements, which are present
 * in both input vectors.
 * This function is called by intersect_array() and f_intersect_alists().
 */

{
    vector_t *a3;
    mp_int d, l, i1, i2, a1s, a2s;

    a1s = (mp_int)VEC_SIZE(a1);
    a2s = (mp_int)VEC_SIZE(a2);
    a3 = allocate_array( a1s < a2s ? a1s : a2s);
    for (i1=i2=l=0; i1 < a1s && i2 < a2s; ) {
        d = svalue_cmp(&a1->item[i1], &a2->item[i2]);
        if (d<0)
            i1++;
        else if (d>0)
            i2++;
        else {
            assign_svalue_no_free(&a3->item[l++], &a2->item[(i1++,i2++)] );
        }
    }
    return shrink_array(a3, l);
} /* intersect_ordered_arr() */

/*-------------------------------------------------------------------------*/
vector_t *
order_alist (svalue_t *inlists, int listnum, Bool reuse)

/* Order the alist <inlists> and return a new vector with it. The sorting
 * order is the internal order defined by alist_cmp().
 *
 * <inlists> is a vector of <listnum> vectors:
 *   <inlists> = ({ ({ keys }), ({ data1 }), ..., ({ data<listnum-1> }) })
 *
 * If <reuse> is true, the vectors of <inlists> are reused for the
 * vectors of the result when possible, and their entries in <inlists> are
 * set to T_INVALID.
 *
 * As a side effect, strings in the key vector are made shared, and
 * destructed objects in key and data vectors are replaced by svalue 0s.
 *
 * This function is also called by the compiler for constant expressions.
 */

{
    vector_t *outlist;   /* The result vector of vectors */
    vector_t *v;         /* Aux vector pointer */
    svalue_t *outlists;  /* Next element in outlist to fill in */
    ptrdiff_t * sorted;  /* The vector elements in sorted order */
    svalue_t *inpnt;     /* Pointer to the value to copy into the result */
    mp_int keynum;       /* Number of keys */
    int i, j;

    keynum = (mp_int)VEC_SIZE(inlists[0].u.vec);

    /* Get the sorting order */

    sorted = get_array_order(inlists[0].u.vec);

    /* Generate the result vectors from the sorting order.
     */

    outlist = allocate_array(listnum);
    outlists = outlist->item;

    /* Copy the elements from all inlist vectors into the outlist
     * vectors.
     *
     * At the beginning of every loop v points to the vector to
     * use as the next 'out' vector. It may be a re-used 'in' vector
     * from the previous run.
     */
    v = allocate_array(keynum);
    for (i = listnum; --i >= 0; ) {

        svalue_t *outpnt; /* Next result value element to fill in */

        /* Set the new array v as the next 'out' vector, and init outpnt
         * and offs.
         */
        put_array(outlists + i, v);
        outpnt = v->item;

        v = inlists[i].u.vec; /* Next vector to fill if reusable */

        /* Copy the elements.
         * For a reusable 'in' vector, a simple memory copy is sufficient.
         * For a new vector, a full assignment is due to keep the refcounters
         * happy.
         */
        if (reuse && inlists[i].u.vec->ref == 1) {

            if (i) /* not the last iteration */
                inlists[i].type = T_INVALID;

            for (j = keynum; --j >= 0; ) {
                inpnt = inlists[i].u.vec->item + sorted[j];
                if (destructed_object_ref(inpnt))
                {
                    free_svalue(inpnt);
                    put_number(outpnt, 0);
                    outpnt++;
                } else {
                    *outpnt++ = *inpnt;
                }
                inpnt->type = T_INVALID;
            }

        } else {

            if (i) /* Not the last iteration: get new out-vector */
                v = allocate_array(keynum);

            for (j = keynum; --j >= 0; ) {
                inpnt = inlists[i].u.vec->item + sorted[j];
                if (destructed_object_ref(inpnt))
                {
                    put_number(outpnt, 0);
                    outpnt++;
                } else {
                    assign_svalue_no_free(outpnt++, inpnt);
                }
            }
        } /* if (reuse) */
    } /* for (listnum) */

    xfree(sorted);

    return outlist;
} /* order_alist() */

/*-------------------------------------------------------------------------*/
static svalue_t *
insert_alist (svalue_t *key, svalue_t * /* TODO: bool */ key_data, vector_t *list)

/* Implementation of efun insert_alist()
 *
 * The function can be used in two ways:
 *
 * 1. Insert/replace a (new) <key>:<keydata> tuple into the alist <list>.
 *    <key> and <key_data> have to point to an array of svalues. The first
 *    element is the key value, the following values the associated
 *    data values. The function will read as many elements from the
 *    array as necessary to fill the alist <list>.
 *    Result is a fresh copy of the modified alist.
 *
 * 2. Lookup a <key> in the alist <list> and return its index. If the key
 *    is not found, return  the position at which it would be inserted.
 *    <key_data> must be NULL, <key> points to the svalue to be looked
 *    up, and <list> points to an alist with at least the key vector.
 *
 * If <list> is no alist, the result can be wrong (case 2.) or not
 * an alist either (case 1.).
 *
 * If the <key> is a string, it is made shared.
 *
 * TODO: Make the hidden flag 'key_data' a real flag.
 */

{
    static svalue_t stmp; /* Result value */
    mp_int i,j,ix;
    mp_int keynum, list_size;  /* Number of keys, number of alist vectors */
    int new_member;            /* Flag if a new tuple is given */

    /* If key is a string, make it shared */
    if (key->type == T_STRING && !mstr_tabled(key->u.str))
    {
        key->u.str = make_tabled(key->u.str);
    }

    keynum = (mp_int)VEC_SIZE(list->item[0].u.vec);

    /* Locate the key */
    ix = lookup_key(key, list->item[0].u.vec);

    /* If its just a lookup: return the result.
     */
    if (key_data == NULL) {
         put_number(&stmp, ix < 0 ? -ix-1 : ix);
         return &stmp;
    }

    /* Prepare the result alist vector */
    put_array(&stmp, allocate_array(list_size = (mp_int)VEC_SIZE(list)));

    new_member = ix < 0;
    if (new_member)
        ix = -ix-1;

    /* Loop over all key/data vectors in <list>, insert/replace the
     * new value and put the new vector into <stmp>.
     */
    for (i = 0; i < list_size; i++) {
        vector_t *vtmp;

        if (new_member) {

            svalue_t *pstmp = list->item[i].u.vec->item;

            vtmp = allocate_array(keynum+1);
            for (j=0; j < ix; j++) {
               assign_svalue_no_free(&vtmp->item[j], pstmp++);
            }
            assign_svalue_no_free(&vtmp->item[ix], i ? &key_data[i] : key );
            for (j = ix+1; j <= keynum; j++) {
               assign_svalue_no_free(&vtmp->item[j], pstmp++);
            }

        } else {

            vtmp = slice_array(list->item[i].u.vec, 0, keynum-1);
            if (i)
                assign_svalue(&vtmp->item[ix], &key_data[i]);
                /* No need to assign the key value: it's already there. */

        }

        stmp.u.vec->item[i].type=T_POINTER;
        stmp.u.vec->item[i].u.vec=vtmp;
    }

    /* Done */
    return &stmp;
} /* insert_alist() */

/*=========================================================================*/

/*                            EFUNS                                        */

/*-------------------------------------------------------------------------*/
svalue_t *
v_insert_alist (svalue_t *sp, int num_arg)

/* EFUN insert_alist()
 *
 *   mixed* insert_alist (mixed key, mixed data..., mixed * alist)
 *   int    insert_alist (mixed key, mixed * keys)
 *
 * 1. Form: Alist Insertion
 *
 *   The <key> and all following <data> values are inserted
 *   into the <alist>. If an entry for <key> already exists
 *   in the list, just the data values are replaced. The number
 *   of <data> values must match the number of data arrays
 *   in the alist, naturally.
 *
 *   Result is the updated <alist>.
 *
 * 2. Form: Key Insertion
 *
 *   Insert the <key> into the (ordered) array of <keys>, so that
 *   subsequent assoc()s can perform quick lookups. Result is the
 *   index at which <key> was inserted (or already found).
 *
 *   CAVEAT: when working with string keys, the index might no longer
 *     be valid after the next call to insert_alist().
 */
/* When the key list of an alist contains destructed objects
   it is better not to free them till the next reordering by
   order_alist to retain the alist property.
 */

{
    int i;
    vector_t *list;
    long listsize;
    size_t keynum;
    svalue_t *key,*key_data,*ret;
    static LOCAL_VEC1(insert_alist_vec, T_NUMBER);
      /* Mock-alist for the insert_alist() key-insertion form.
       */

    if (sp->type != T_POINTER)
        vefun_arg_error(num_arg, T_POINTER, sp->type, sp);

    /* Make up an alist if only a key-insertion is required */
    if ( !(listsize = (long)VEC_SIZE(sp->u.vec))
     ||  sp->u.vec->item[0].type != T_POINTER )
    {
        list = &insert_alist_vec.v;
        *list->item = *sp;
        listsize = 1;
    }
    else
        list = sp->u.vec;

    /* Check the validity of the alist */
    keynum = VEC_SIZE(list->item[0].u.vec);
    for (i = 1; i < listsize; i++)
    {
        if (list->item[i].type != T_POINTER
         || (size_t)VEC_SIZE(list->item[i].u.vec) != keynum)
        {
            errorf("Type or size mismatch of the data arrays.\n");
            /* NOTREACHED */
            return sp;
        }
    }

    /* Get and test the data to insert */
    if (num_arg == 2)
    {
        if (sp[-1].type != T_POINTER)
        {
            key_data = NULL;
            key = sp-1;
        }
        else
        {
            if (VEC_SIZE(sp[-1].u.vec) != listsize)
            {
                errorf("Size mismatch of the data arrays: "
                      "vec size %ld, list size %ld.\n"
                     , (long)VEC_SIZE(sp[-1].u.vec), (long)listsize
                     );
                /* NOTREACHED */
                return sp;
            }
            key_data = key = sp[-1].u.vec->item;
        }
    }
    else
    {
        if (num_arg - 1 != listsize)
        {
            errorf("Not enough data given: %ld arguments, %ld listsize.\n"
                 , (long)num_arg - 1, (long)listsize);
            /* NOTREACHED */
            return sp;
        }
        key_data = key = sp-num_arg+1;
    }

    /* Do the insertion */
    ret = insert_alist(key,key_data,list);
    sp = pop_n_elems(num_arg, sp);
    sp++;
    *sp = *ret;

    return sp;
} /* v_insert_alist() */

/*-------------------------------------------------------------------------*/
svalue_t *
v_assoc (svalue_t *sp, int num_arg)

/* EFUN assoc()
 *
 *     int   assoc (mixed key, mixed *keys)
 *     mixed assoc (mixed key, mixed *alist [, mixed fail] )
 *     mixed assoc (mixed key, mixed *keys, mixed *data [, mixed fail])
 *
 * Search for <key> in the <alist> resp. in the <keys>.
 *
 * When the key list of an alist contains destructed objects
 * it is better not to free them till the next reordering by
 * order_alist to retain the alist property.
 */

{
    svalue_t *args;
    vector_t *keys,*data;
    svalue_t *fail_val;
    int ix;

    args = sp -num_arg +1;

    /* Analyse the arguments */
    if ( !VEC_SIZE(args[1].u.vec)
     ||  args[1].u.vec->item[0].type != T_POINTER )
    {
        keys = args[1].u.vec;
        if (num_arg == 2)
        {
            data = NULL;
        }
        else
        {
            if (args[2].type != T_POINTER
             || VEC_SIZE(args[2].u.vec) != VEC_SIZE(keys))
            {
                errorf("Number of values in key and data arrays differ.\n");
                /* NOTREACHED */
                return sp;
            }
            data = args[2].u.vec;
        }
        if (num_arg == 4)
        {
            fail_val = &args[3];
        }
        else
        {
            fail_val = &const0;
        }
    }
    else
    {
        keys = args[1].u.vec->item[0].u.vec;
        if (VEC_SIZE(args[1].u.vec) > 1)
        {
            if (args[1].u.vec->item[1].type != T_POINTER
             || VEC_SIZE(args[1].u.vec->item[1].u.vec) != VEC_SIZE(keys))
            {
                errorf("Number of values in key and data arrays differ.\n");
                /* NOTREACHED */
                return sp;
            }
            data = args[1].u.vec->item[1].u.vec;
        }
        else
        {
            data = NULL;
        }

        if (num_arg == 3) fail_val = &args[2];
        else if (num_arg == 2) fail_val = &const0;
        else
        {
            errorf("too many args to efun assoc\n");
            /* NOTREACHED */
            return sp;
        }
    }

    /* Call lookup_key() and push the result */
    ix = lookup_key(&args[0],keys);
    if (data == NULL)
    {
        sp = pop_n_elems(num_arg, sp);
        push_number(sp, ix < 0 ? -1 : ix);
    }
    else
    {
        assign_svalue(args
                     , ix < 0
                       ? fail_val
                       : (destructed_object_ref(&data->item[ix])
                         ? &const0
                         : &data->item[ix])
                     );
        sp = pop_n_elems(num_arg-1, sp);
    }

    return sp;
} /* v_assoc() */

/*-------------------------------------------------------------------------*/
svalue_t *
f_intersect_alist (svalue_t *sp)

/* EFUN intersect_alist()
 *
 *   mixed * intersect_alist (mixed * list1, mixed * list2)
 *
 * Does a fast set intersection on alist key vectors (NOT on full
 * alists!).
 *
 * The result is a new sorted(!) vector with all elements, which are present
 * in both input vectors.
 *
 * The operator '&' does set intersection on arrays in
 * general.
 *
 * TODO: Maybe rename the efun.
 */

{
    vector_t *rc;

    rc = intersect_ordered_arr(sp[-1].u.vec, sp->u.vec);

    free_svalue(sp--);
    free_array(sp->u.vec);
    sp->u.vec = rc;

    return sp;
} /* f_intersect_alist() */

/*-------------------------------------------------------------------------*/
svalue_t *
v_order_alist (svalue_t *sp, int num_arg)

/* EFUN order_alist()
 *
 *   mixed *order_alist(mixed *keys, mixed *|void data, ...)
 *
 * Creates an alist.
 *
 * Either takes an array containing keys, and others containing
 * the associated data, where all arrays are to be of the same
 * length, or takes a single array that contains as first member
 * the array of keys and has an arbitrary number of other members
 * containing data, each of wich has to be of the same length as
 * the key array. Returns an array holding the sorted key array
 * and the data arrays; the same permutation that is applied to
 * the key array is applied to all data arrays.
 */

{
    int i;
    svalue_t *args;
    vector_t *list;
    long listsize;
    Bool reuse;
    size_t keynum;

    args = sp-num_arg+1;

    /* Get the key array to order */
    if (num_arg == 1
      && ((list = args->u.vec), (listsize = (long)VEC_SIZE(list)))
      && list->item[0].type == T_POINTER)
    {
        args     = list->item;
        reuse = (list->ref == 1);
    }
    else
    {
        listsize = num_arg;
        reuse = MY_TRUE;
    }
    keynum = VEC_SIZE(args[0].u.vec);

    /* Get the data arrays to order */
    for (i = 0; i < listsize; i++)
    {
        if (args[i].type != T_POINTER
         || (size_t)VEC_SIZE(args[i].u.vec) != keynum)
        {
            errorf("bad data array %d in call to order_alist\n",i);
        }
    }

    /* Create the alist */
    list = order_alist(args, listsize, reuse);
    sp = pop_n_elems(num_arg, sp);
    sp++;
    put_array(sp, list);

    return sp;
} /* v_order_alist() */

#endif /* USE_ALISTS */

/***************************************************************************/