words.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/database.h>
#include <plang/errors.h>
#include <stdlib.h>
#include <string.h>
#include <wn.h>

#define P_WORD_HASH_SIZE 511
typedef struct p_word p_word;
struct p_word
{
    p_word *next;
    unsigned int word_flags;
    char word[1];
};
static p_word *p_word_hash[P_WORD_HASH_SIZE];
static int p_initialized = 0;
/* Match two words, where "word1" is assumed to already
 * be in lower case and normalized */
static int p_word_match(const char *word1, const char *word2)
{
    int ch1, ch2;
    while (*word1 != '\0' && *word2 != '\0') {
        ch1 = ((int)(*word1++)) & 0xFF;
        ch2 = ((int)(*word2++)) & 0xFF;
        if (ch2 >= 'A' && ch2 <= 'Z')
            ch2 += 'a' - 'A';
        else if (ch2 == ' ')
            ch2 = '_';
        if (ch1 != ch2)
            return 0;
    }
    return *word1 == '\0' && *word2 == '\0';
}

/* Copy a string, converting to lower case and normalizing */
static void p_word_strcpy(char *dest, const char *src)
{
    int ch;
    while (*src != '\0') {
        ch = ((int)(*src++)) & 0xFF;
        if (ch >= 'A' && ch <= 'Z')
            ch += 'a' - 'A';
        else if (ch == ' ')
            ch = '_';
        *dest++ = (char)ch;
    }
    *dest = '\0';
}

/* Check the kind on a word.  We cache the results from WordNet
 * because it doesn't implement its own cache */
static p_goal_result word_check
    (p_context *context, p_term *word, int kind)
{
    int type;
    const char *name;
    const char *temp;
    unsigned int hash;
    unsigned int ch;
    size_t len;
    p_word *current;
    char *baseform;
    char *wordstr;
    int pos;

    /* Check that the word term is an atom or string */
    word = p_term_deref_member(context, word);
    type = p_term_type(word);
    if (type != P_TERM_ATOM && type != P_TERM_STRING)
        return P_RESULT_FAIL;

    /* Check against WordNet's maximum word size */
    if (p_term_name_length(word) >= (size_t)(WORDBUF - 1))
        return P_RESULT_FAIL;

    /* Compute the hash value for the word */
    name = p_term_name(word);
    temp = name;
    hash = 0;
    len = 0;
    while (*temp != '\0') {
        ch = ((unsigned int)(*temp++)) & 0xFF;
        if (ch >= 'A' && ch <= 'Z')
            ch += 'a' - 'A';
        else if (ch == ' ')
            ch = '_';
        hash = hash * 5 + ch;
        ++len;
    }
    hash %= P_WORD_HASH_SIZE;

    /* Search for the word in the hash */
    current = p_word_hash[hash];
    while (current) {
        if (p_word_match(current->word, name)) {
            if (current->word_flags & bit(kind))
                return P_RESULT_TRUE;
            else
                return P_RESULT_FAIL;
        }
        current = current->next;
    }

    /* Create a new hash node for the word */
    current = (p_word *)malloc(sizeof(p_word) + len);
    if (!current)
        return P_RESULT_FAIL;
    current->next = p_word_hash[hash];
    p_word_strcpy(current->word, name);
    p_word_hash[hash] = current;

    /* Fetch all flags for the word and its base forms
     * and cache them in the hash */
    current->word_flags = in_wn(current->word, ALL_POS);
    for (pos = NOUN; pos <= ADV; ++pos) {
        if (current->word_flags & bit(pos))
            continue;
        wordstr = current->word;
        while ((baseform = morphstr(wordstr, pos)) != 0) {
            current->word_flags |= in_wn(baseform, pos);
            wordstr = 0;
        }
    }
    if (current->word_flags & bit(kind))
        return P_RESULT_TRUE;
    else
        return P_RESULT_FAIL;
}

static int is_instantiated(const p_term *term)
{
    if (!term)
        return 0;
    else if ((p_term_type(term) & P_TERM_VARIABLE) != 0)
        return 0;
    else
        return 1;
}

struct p_wn_code
{
    const char *name;
    int value;
};
static struct p_wn_code const parts_of_speech[] = {
    {"noun", NOUN},
    {"verb", VERB},
    {"adjective", ADJ},
    {"adverb", ADV},
    {0, -1}
};
#define FETCH_SYNSET    1024    /* Special value for words::search/5 */
static struct p_wn_code const queries[] = {
    {"antptr", ANTPTR},
    {"hyperptr", HYPERPTR},
    {"hypoptr", HYPOPTR},
    {"entailptr", ENTAILPTR},
    {"simptr", SIMPTR},
    {"ismemberptr", ISMEMBERPTR},
    {"isstuffptr", ISSTUFFPTR},
    {"ispartptr", ISPARTPTR},
    {"hasmemberptr", HASMEMBERPTR},
    {"hasstuffptr", HASSTUFFPTR},
    {"haspartptr", HASPARTPTR},
    {"meronym", MERONYM},
    {"holonym", HOLONYM},
    {"causeto", CAUSETO},
    {"pplptr", PPLPTR},
    {"seealsoptr", SEEALSOPTR},
    {"pertptr", PERTPTR},
    {"attribute", ATTRIBUTE},
    {"verbgroup", VERBGROUP},
    {"derivation", DERIVATION},
    {"classification", CLASSIFICATION},
    {"class", CLASS},
    {"syns", SYNS},
    {"freq", FREQ},
    {"frames", FRAMES},
    {"coords", COORDS},
    {"relatives", RELATIVES},
    {"hmeronym", HMERONYM},
    {"hholonym", HHOLONYM},
    {"wngrep", WNGREP},
    {"overview", OVERVIEW},
    {"classif_category", CLASSIF_CATEGORY},
    {"classif_usage", CLASSIF_USAGE},
    {"classif_regional", CLASSIF_REGIONAL},
    {"class_category", CLASS_CATEGORY},
    {"class_usage", CLASS_USAGE},
    {"class_regional", CLASS_REGIONAL},
    {"instance", INSTANCE},
    {"instances", INSTANCES},
    {"synset", FETCH_SYNSET},
    {0, -1}
};
static int lookup_code(const struct p_wn_code *codes, const p_term *code)
{
    const char *name;
    if (p_term_type(code) != P_TERM_ATOM)
        return -1;
    name = p_term_name(code);
    while (codes->name && strcmp(codes->name, name) != 0)
        ++codes;
    return codes->value;
}

/* Collect up search results from findtheinfo_ds() */
static void collect_db_search
    (p_context *context, p_term **head, p_term **tail,
     SynsetPtr synset, int recurse)
{
    int index;
    p_term *list;
    while (synset) {
        for (index = 0; index < synset->wcount; ++index) {
            list = *head;
            while (list) {
                if (!strcmp(p_term_name(p_term_head(list)),
                            synset->words[index]))
                    break;
                list = p_term_tail(list);
            }
            if (!list) {
                p_term *str = p_term_create_string
                    (context, synset->words[index]);
                if (*tail) {
                    list = p_term_create_list(context, str, 0);
                    p_term_set_tail(*tail, list);
                    *tail = list;
                } else {
                    *tail = p_term_create_list(context, str, 0);
                    *head = *tail;
                }
            }
        }
        if (recurse) {
            collect_db_search
                (context, head, tail, synset->ptrlist, recurse);
        }
        synset = synset->nextss;
    }
}

/* Search the database for a description or a matching word list */
#define DB_SEARCH           0
#define DB_DESCRIPTION      1
static p_goal_result words_db_search
    (p_context *context, p_term **args, p_term **error, int search_type)
{
    p_term *word = p_term_deref_member(context, args[0]);
    p_term *part_of_speech = p_term_deref_member(context, args[1]);
    p_term *query = p_term_deref_member(context, args[2]);
    p_term *sense = p_term_deref_member(context, args[3]);
    p_term *result = p_term_deref_member(context, args[4]);
    int type, wn_part_of_speech, wn_query, wn_sense, ch;
    char *norm_word, *temp;
    p_term *str;
    p_goal_result goal_result;

    /* Validate the parameters to the predicate */
    if (!is_instantiated(word) || !is_instantiated(part_of_speech) ||
            !is_instantiated(query) || !is_instantiated(sense)) {
        *error = p_create_instantiation_error(context);
        return P_RESULT_ERROR;
    }
    if (is_instantiated(result)) {
        *error = p_create_type_error(context, "variable", result);
        return P_RESULT_ERROR;
    }
    type = p_term_type(word);
    if (type != P_TERM_ATOM && type != P_TERM_STRING) {
        *error = p_create_type_error(context, "atom_or_string", word);
        return P_RESULT_ERROR;
    }
    wn_part_of_speech = lookup_code(parts_of_speech, part_of_speech);
    if (wn_part_of_speech < 0) {
        *error = p_create_type_error(context, "part_of_speech", part_of_speech);
        return P_RESULT_ERROR;
    }
    wn_query = lookup_code(queries, query);
    if (wn_query < 0 || (wn_query == FETCH_SYNSET &&
                         search_type != DB_SEARCH)) {
        *error = p_create_type_error(context, "word_query", query);
        return P_RESULT_ERROR;
    }
    type = p_term_type(sense);
    if (type == P_TERM_INTEGER) {
        wn_sense = p_term_integer_value(sense);
        if (wn_sense < 1)
            wn_sense = -1;
    } else if (type == P_TERM_ATOM &&
               !strcmp(p_term_name(sense), "allsenses")) {
        wn_sense = ALLSENSES;
    } else {
        wn_sense = -1;
    }
    if (wn_sense < 0) {
        *error = p_create_type_error(context, "word_sense", sense);
        return P_RESULT_ERROR;
    }

    /* Bail out if the word is too long for WordNet */
    if (p_term_name_length(word) >= (size_t)(WORDBUF - 1))
        return P_RESULT_FAIL;

    /* Normalize the word to lower case with "_" as word separator */
    norm_word = (char *)malloc(p_term_name_length(word) + 1);
    if (!norm_word)
        return P_RESULT_FAIL;
    strcpy(norm_word, p_term_name(word));
    temp = norm_word;
    while ((ch = *temp) != '\0') {
        if (ch >= 'A' && ch <= 'Z')
            *temp = (char)(ch + 'a' - 'A');
        else if (ch == ' ')
            *temp = '_';
        ++temp;
    }

    /* Perform the query against the database */
    goal_result = P_RESULT_FAIL;
    if (search_type == DB_DESCRIPTION) {
        /* Fetch the human-readable description of the results */
        temp = findtheinfo
            (norm_word, wn_part_of_speech, wn_query, wn_sense);
        if (temp && *temp != '\0') {
            str = p_term_create_string(context, temp);
            if (p_term_unify(context, result, str, P_BIND_DEFAULT))
                goal_result = P_RESULT_TRUE;
        }
    } else if (wn_query != FETCH_SYNSET) {
        /* Search for words in some relation with this word */
        p_term *head = 0;
        p_term *tail = 0;
        SynsetPtr synset = findtheinfo_ds
            (norm_word, wn_part_of_speech, wn_query, wn_sense);
        while (synset) {
            collect_db_search
                (context, &head, &tail, synset->ptrlist, 1);
            synset = synset->nextss;
        }
        if (head) {
            p_term_set_tail(tail, p_term_nil_atom(context));
            if (p_term_unify(context, result, head, P_BIND_DEFAULT))
                goal_result = P_RESULT_TRUE;
        }
    } else {
        /* Search for members of the synset itself.  Choose a
         * "synonym query" that will work for the part of speech */
        p_term *head = 0;
        p_term *tail = 0;
        if (wn_part_of_speech == ADJ)
            wn_query = SIMPTR;
        else if (wn_part_of_speech == ADV)
            wn_query = SYNS;
        else
            wn_query = HYPERPTR;
        SynsetPtr synset = findtheinfo_ds
            (norm_word, wn_part_of_speech, wn_query, wn_sense);
        while (synset) {
            collect_db_search(context, &head, &tail, synset, 0);
            synset = synset->nextss;
        }
        if (head) {
            p_term_set_tail(tail, p_term_nil_atom(context));
            if (p_term_unify(context, result, head, P_BIND_DEFAULT))
                goal_result = P_RESULT_TRUE;
        }
    }
    free(norm_word);
    return goal_result;
}

static p_goal_result words_adjective
    (p_context *context, p_term **args, p_term **error)
{
    return word_check(context, args[0], ADJ);
}

static p_goal_result words_adverb
    (p_context *context, p_term **args, p_term **error)
{
    return word_check(context, args[0], ADV);
}

static p_goal_result words_base_forms
    (p_context *context, p_term **args, p_term **error)
{
    p_term *word = p_term_deref_member(context, args[0]);
    p_term *part_of_speech = p_term_deref_member(context, args[1]);
    int type, wn_part_of_speech;
    char *baseform;
    p_term *head;
    p_term *tail;
    p_term *new_tail;

    /* Validate the parameters to the predicate */
    if (!is_instantiated(word) || !is_instantiated(part_of_speech)) {
        *error = p_create_instantiation_error(context);
        return P_RESULT_ERROR;
    }
    type = p_term_type(word);
    if (type != P_TERM_ATOM && type != P_TERM_STRING) {
        *error = p_create_type_error(context, "atom_or_string", word);
        return P_RESULT_ERROR;
    }
    wn_part_of_speech = lookup_code(parts_of_speech, part_of_speech);
    if (wn_part_of_speech < 0) {
        *error = p_create_type_error(context, "part_of_speech", part_of_speech);
        return P_RESULT_ERROR;
    }

    /* Bail out if the word is too long for WordNet */
    if (p_term_name_length(word) >= (size_t)(WORDBUF - 1))
        return P_RESULT_FAIL;

    /* Query for the morph words */
    baseform = morphstr((char *)p_term_name(word), wn_part_of_speech);
    if (!baseform)
        return P_RESULT_FAIL;
    head = tail = p_term_create_list
        (context, p_term_create_string(context, baseform), 0);
    while ((baseform = morphstr(0, wn_part_of_speech)) != 0) {
        new_tail = p_term_create_list
            (context, p_term_create_string(context, baseform), 0);
        p_term_set_tail(tail, new_tail);
        tail = new_tail;
    }
    p_term_set_tail(tail, p_term_nil_atom(context));

    /* Unify with the result argument and return */
    if (p_term_unify(context, args[2], head, P_BIND_DEFAULT))
        return P_RESULT_TRUE;
    else
        return P_RESULT_FAIL;
}

static p_goal_result words_description
    (p_context *context, p_term **args, p_term **error)
{
    return words_db_search(context, args, error, DB_DESCRIPTION);
}

static p_goal_result words_noun
    (p_context *context, p_term **args, p_term **error)
{
    return word_check(context, args[0], NOUN);
}

static p_goal_result words_search
    (p_context *context, p_term **args, p_term **error)
{
    return words_db_search(context, args, error, DB_SEARCH);
}

static p_goal_result words_verb
    (p_context *context, p_term **args, p_term **error)
{
    return word_check(context, args[0], VERB);
}

void plang_module_setup(p_context *context)
{
    if (p_initialized) {
        re_wninit();
    } else {
        wninit();
        p_initialized = 1;
    }
    p_db_set_builtin_predicate
        (p_term_create_atom(context, "words::adjective"), 1, words_adjective);
    p_db_set_builtin_predicate
        (p_term_create_atom(context, "words::adverb"), 1, words_adverb);
    p_db_set_builtin_predicate
        (p_term_create_atom(context, "words::base_forms"), 3, words_base_forms);
    p_db_set_builtin_predicate
        (p_term_create_atom(context, "words::description"), 5, words_description);
    p_db_set_builtin_predicate
        (p_term_create_atom(context, "words::noun"), 1, words_noun);
    p_db_set_builtin_predicate
        (p_term_create_atom(context, "words::search"), 5, words_search);
    p_db_set_builtin_predicate
        (p_term_create_atom(context, "words::verb"), 1, words_verb);
}

void plang_module_shutdown(p_context *context)
{
    int index;
    p_word *current;
    p_word *next;
    for (index = 0; index < P_WORD_HASH_SIZE; ++index) {
        current = p_word_hash[index];
        while (current) {
            next = current->next;
            free(current);
            current = next;
        }
        p_word_hash[index] = 0;
    }
}

---