sort.c

/*
 * plang logic programming language
 * Copyright (C) 2011  Southern Storm Software, Pty Ltd.
 *
 * The plang package is free software: you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation, either version 3 of
 * the License, or (at your option) any later version.
 *
 * The plang package is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with the libcompiler library.  If not,
 * see <http://www.gnu.org/licenses/>.
 */

#include <plang/term.h>
#include <plang/errors.h>
#include "term-priv.h"
#include "context-priv.h"
#include "database-priv.h"

P_INLINE int p_term_sort_compare
    (p_context *context, p_term *term1, p_term *term2, int flags)
{
    int cmp;
    if (flags & P_SORT_KEYED) {
        if (term1->header.type == P_TERM_FUNCTOR &&
                term1->header.size == 2)
            term1 = term1->functor.arg[0];
        if (term2->header.type == P_TERM_FUNCTOR &&
                term2->header.size == 2)
            term2 = term2->functor.arg[0];
    } else if (flags & P_SORT_REVERSE_KEYED) {
        if (term1->header.type == P_TERM_FUNCTOR &&
                term1->header.size == 2)
            term1 = term1->functor.arg[1];
        if (term2->header.type == P_TERM_FUNCTOR &&
                term2->header.size == 2)
            term2 = term2->functor.arg[1];
    }
    cmp = p_term_precedes(context, term1, term2);
    if (flags & P_SORT_DESCENDING)
        return -cmp;
    else
        return cmp;
}

/* Recursive merge sort within an array.  "Algorithms in C++",
 * Robert Sedgewick, Addison-Wesley, 1992 */
static void p_term_sort_section
    (p_context *context, p_term **array, p_term **temp,
     int left, int right, int flags)
{
    int middle, i, j, k;
    if (left >= right)
        return;
    middle = (left + right) / 2;
    p_term_sort_section(context, array, temp, left, middle, flags);
    p_term_sort_section(context, array, temp, middle + 1, right, flags);
    for (i = middle + 1; i > left; --i)
        temp[i - 1] = array[i - 1];
    for (j = middle; j < right; ++j)
        temp[right + middle - j] = array[j + 1];
    for (k = left; k <= right; ++k) {
        if (p_term_sort_compare(context, temp[i], temp[j], flags) <= 0)
            array[k] = temp[i++];
        else
            array[k] = temp[j--];
    }
}

/* Convert the contents of a non-empty array into a list */
static p_term *p_term_section_to_list
    (p_context *context, p_term **array, int size, int flags)
{
    p_term *list = p_term_create_list(context, array[0], 0);
    p_term *tail = list;
    p_term *new_tail;
    int index;
    if (!list)
        return 0;
    if ((flags & P_SORT_UNIQUE) == 0) {
        for (index = 1; index < size; ++index) {
            new_tail = p_term_create_list(context, array[index], 0);
            if (!new_tail)
                return 0;
            p_term_set_tail(tail, new_tail);
            tail = new_tail;
        }
    } else {
        for (index = 1; index < size; ++index) {
            if (!p_term_sort_compare
                    (context, array[index - 1], array[index], flags))
                continue;
            new_tail = p_term_create_list(context, array[index], 0);
            if (!new_tail)
                return 0;
            p_term_set_tail(tail, new_tail);
            tail = new_tail;
        }
    }
    p_term_set_tail(tail, context->nil_atom);
    return list;
}

/* Merge two sorted lists */
static p_term *p_term_sort_merge
    (p_context *context, p_term *list1, p_term *list2, int flags)
{
    p_term *head = 0;
    p_term *tail = 0;
    int cmp;
    for (;;) {
        if (list1 == context->nil_atom) {
            if (head)
                p_term_set_tail(tail, list2);
            else
                head = list2;
            break;
        }
        if (list2 == context->nil_atom) {
            if (head)
                p_term_set_tail(tail, list1);
            else
                head = list1;
            break;
        }
        cmp = p_term_sort_compare(context, list1->list.head,
                                  list2->list.head, flags);
        if (cmp <= 0) {
            if (head)
                p_term_set_tail(tail, list1);
            else
                head = list1;
            tail = list1;
            list1 = list1->list.tail;
            if (!cmp && (flags & P_SORT_UNIQUE) != 0)
                list2 = list2->list.tail;
        } else {
            if (head)
                p_term_set_tail(tail, list2);
            else
                head = list2;
            tail = list2;
            list2 = list2->list.tail;
        }
    }
    return head;
}

p_term *p_term_sort(p_context *context, p_term *list, int flags)
{
#define P_SORT_SECTION_SIZE     256
    p_term *array[P_SORT_SECTION_SIZE];
    p_term *temp[P_SORT_SECTION_SIZE];
    int size;
    p_term *section;
    p_term *sections;

    /* Bail out if not a valid list, or an empty list */
    list = p_term_deref(list);
    if (!list)
        return 0;
    if (list == context->nil_atom)
        return list;
    if (list->header.type != P_TERM_LIST)
        return 0;

    /* Break the list up into sections and sort each section
     * using an array-based merge sort procedure */
    size = 0;
    sections = 0;
    do {
        if ((array[size++] = p_term_deref(list->list.head)) == 0)
            return 0;
        if (size >= P_SORT_SECTION_SIZE) {
            p_term_sort_section
                (context, array, temp, 0, size - 1, flags);
            section = p_term_section_to_list
                (context, array, size, flags);
            if (!section)
                return 0;
            if (sections) {
                sections = p_term_sort_merge
                    (context, sections, section, flags);
            } else {
                sections = section;
            }
            size = 0;
        }
        list = p_term_deref(list->list.tail);
    } while (list && list->header.type == P_TERM_LIST);
    if (list && (list->header.type & P_TERM_VARIABLE) == 0 &&
            list != context->nil_atom)
        return 0;       /* Tail is not a variable or nil */
    if (size > 0) {
        p_term_sort_section(context, array, temp, 0, size - 1, flags);
        section = p_term_section_to_list(context, array, size, flags);
        if (!section)
            return 0;
        if (sections) {
            sections = p_term_sort_merge
                (context, sections, section, flags);
        } else {
            sections = section;
        }
    }
    return sections;
}

static p_goal_result p_builtin_common_sort
    (p_context *context, p_term **args, p_term **error, int flags)
{
    p_term *list = p_term_deref_member(context, args[0]);
    p_term *sorted;
    if (!list || (list->header.type & P_TERM_VARIABLE) != 0) {
        *error = p_create_instantiation_error(context);
        return P_RESULT_ERROR;
    }
    sorted = p_term_sort(context, list, flags);
    if (!sorted) {
        *error = p_create_type_error(context, "list", list);
        return P_RESULT_ERROR;
    }
    if (p_term_unify(context, args[1], sorted, P_BIND_DEFAULT))
        return P_RESULT_TRUE;
    else
        return P_RESULT_FAIL;
}

static p_goal_result p_builtin_keysort
    (p_context *context, p_term **args, p_term **error)
{
    return p_builtin_common_sort
        (context, args, error, P_SORT_ASCENDING | P_SORT_KEYED);
}

static p_goal_result p_builtin_keysortd
    (p_context *context, p_term **args, p_term **error)
{
    return p_builtin_common_sort
        (context, args, error, P_SORT_DESCENDING | P_SORT_KEYED);
}

static p_goal_result p_builtin_msort
    (p_context *context, p_term **args, p_term **error)
{
    return p_builtin_common_sort
        (context, args, error, P_SORT_ASCENDING);
}

static p_goal_result p_builtin_msortd
    (p_context *context, p_term **args, p_term **error)
{
    return p_builtin_common_sort
        (context, args, error, P_SORT_DESCENDING);
}

static p_goal_result p_builtin_rkeysort
    (p_context *context, p_term **args, p_term **error)
{
    return p_builtin_common_sort
        (context, args, error, P_SORT_ASCENDING | P_SORT_REVERSE_KEYED);
}

static p_goal_result p_builtin_rkeysortd
    (p_context *context, p_term **args, p_term **error)
{
    return p_builtin_common_sort
        (context, args, error, P_SORT_DESCENDING | P_SORT_REVERSE_KEYED);
}

static p_goal_result p_builtin_sort
    (p_context *context, p_term **args, p_term **error)
{
    return p_builtin_common_sort
        (context, args, error, P_SORT_ASCENDING | P_SORT_UNIQUE);
}

static p_goal_result p_builtin_sortd
    (p_context *context, p_term **args, p_term **error)
{
    return p_builtin_common_sort
        (context, args, error, P_SORT_DESCENDING | P_SORT_UNIQUE);
}

void _p_db_init_sort(p_context *context)
{
    static struct p_builtin const builtins[] = {
        {"keysort", 2, p_builtin_keysort},
        {"keysortd", 2, p_builtin_keysortd},
        {"msort", 2, p_builtin_msort},
        {"msortd", 2, p_builtin_msortd},
        {"rkeysort", 2, p_builtin_rkeysort},
        {"rkeysortd", 2, p_builtin_rkeysortd},
        {"sort", 2, p_builtin_sort},
        {"sortd", 2, p_builtin_sortd},
        {0, 0, 0}
    };
    _p_db_register_builtins(context, builtins);
}

---