/*
  This file demonstrates the use of R's external pointers

  The freq_data struct is used to accumulate alphabet frequency across
  a number of input files.  The nid_make_freq_data function allocates
  a new freq_data struct and wraps it in an EXTPTRSXP.  A finalizer is
  registered so that freq_data is properly released when the EXTPTRSXP
  goes out of scope.

  You can add data to the freq_data inside the external pointer via
  nid_update_freq.

  You can get the current data out of a freq_data using
  nid_report_freq.
*/

#include <R.h>                  /* Calloc/Free */
#include <Rinternals.h>
#include <stdio.h>
#include <ctype.h>
#include <string.h>

struct freq_data {
    int file_count;
    int data[26];
};

static void _freq_data_finalizer(SEXP xp)
{
    struct freq_data *fd = (struct freq_data *) R_ExternalPtrAddr(xp);
    if (fd) {
        SEXP t = R_ExternalPtrTag(xp);
        if (Rf_isString(t)) {
            Rprintf("finalizing freq_data '%s'\n",
                    CHAR(STRING_ELT(t, 0)));
        }
        Free(fd);
    }
    R_ClearExternalPtr(xp);
}

SEXP nid_make_freq_data(SEXP id)
{
    struct freq_data *fd = (struct freq_data *) Calloc(1, struct freq_data);
    SEXP xp = R_MakeExternalPtr(fd, id, R_NilValue);

    PROTECT(xp);
    memset(fd->data, 0, sizeof(int) * 26);
    fd->file_count = 0;
    R_RegisterCFinalizerEx(xp, _freq_data_finalizer, TRUE);
    UNPROTECT(1);
    return xp;
}

static int update_freq(const char *file, int *freq_data)
{
    FILE *fh = fopen(file, "r");
    int c, res;
    while (EOF != (c = getc(fh))) {
        int i = tolower(c) - 'a';
        if (i > -1 && i < 26) freq_data[i] += 1;
    }
    res = ferror(fh);
    fclose(fh);
    return res;
}

SEXP nid_update_freq(SEXP xp, SEXP fname)
{
    const char *file = CHAR(STRING_ELT(fname, 0));
    struct freq_data *fd = (struct freq_data *)R_ExternalPtrAddr(xp);
    fd->file_count++;
    update_freq(file, fd->data);
    return xp;
}

static void _add_alpha_names(SEXP v)
{
    SEXP nms = Rf_allocVector(STRSXP, LENGTH(v));
    int i;
    char buf[2] = { 'a', '\0' };
    PROTECT(nms);
    for (i = 0; i < 26; i++) {
        buf[0] = 'a' + i;
        SET_STRING_ELT(nms, i, mkChar(buf));
    }
    Rf_setAttrib(v, R_NamesSymbol, nms);
    UNPROTECT(1);
}

SEXP nid_report_freq(SEXP xp)
{
    SEXP ans, ans_nms, s_freq;
    struct freq_data *fd = (struct freq_data *)R_ExternalPtrAddr(xp);
    int i, *freq_data;
    
    PROTECT(s_freq = Rf_allocVector(INTSXP, 26));
    freq_data = INTEGER(s_freq);
    for (i = 0; i < 26; i++) {
        freq_data[i] = fd->data[i];
    }
    _add_alpha_names(s_freq);

    PROTECT(ans_nms = Rf_allocVector(STRSXP, 2));
    SET_STRING_ELT(ans_nms, 0, mkChar("file_count"));
    SET_STRING_ELT(ans_nms, 1, mkChar("freq"));
    PROTECT(ans = Rf_allocVector(VECSXP, 2));
    Rf_setAttrib(ans, R_NamesSymbol, ans_nms);

    SET_VECTOR_ELT(ans, 0, Rf_ScalarInteger(fd->file_count));
    SET_VECTOR_ELT(ans, 1, s_freq);

    UNPROTECT(3);
    return ans;
}
