#include "data.table.h"

#define ENC_KNOWN(x) (LEVELS(x) & 76)
// LATIN1_MASK (1<<2) | UTF8_MASK (1<<3) | ASCII_MASK (1<<6)

SEXP match_logical(SEXP table, SEXP x) {
  R_len_t i;
  SEXP ans, m;
  ans = PROTECT(allocVector(LGLSXP, length(x)));
  m = PROTECT(match(table, x, 0)); // nomatch=0
  for (i=0; i<length(x); i++)
    INTEGER(ans)[i] = INTEGER(m)[i] > 0;
  UNPROTECT(2);
  return(ans);
}

SEXP chmatch(SEXP x, SEXP table, R_len_t nomatch, Rboolean in) {
  R_len_t i, m;
  SEXP ans, s;
  if (!isString(x) && !isNull(x)) error("x is type '%s' (must be 'character' or NULL)", type2char(TYPEOF(x)));
  if (!isString(table) && !isNull(table)) error("table is type '%s' (must be 'character' or NULL)", type2char(TYPEOF(table)));
  PROTECT(ans = allocVector(in ? LGLSXP : INTSXP,length(x))); // if fails, it fails before savetl
  savetl_init();
  for (i=0; i<length(x); i++) {
    s = STRING_ELT(x,i);
    if (s != NA_STRING && ENC_KNOWN(s) != 64) { // PREV: s != NA_STRING && !ENC_KNOWN(s) - changed to fix for bug #5159. The previous fix
                       // dealt with UNKNOWN encodings. But we could have the same string, where both are in different
                       // encodings than ASCII (ex: UTF8 and Latin1). To fix this, we'll to resort to 'match' if not ASCII.
                       // This takes care of all anomalies. It's unfortunate the 'chmatch' can't be used in these cases...
                       // // fix for the 2nd part of bug #5159

      // explanation for PREV case: (still useful to keep it here)
      // symbols (i.e. as.name() or as.symbol()) containing non-ascii characters (>127) seem to be 'unknown' encoding in R.
      // The same string in different encodings (where unknown encoding is different to known, too) are different
      // CHARSXP pointers; this chmatch relies on pointer equality only. We tried mkChar(CHAR(s)) [ what install() does ]
      // but this impacted the fastest cases too much. Hence fall back to match() on the first unknown encoding detected
      // since match() considers the same string in different encodings as equal (but slower). See #2538 and #4818.
      savetl_end();
      UNPROTECT(1);
      return (in ? match_logical(table, x) : match(table, x, nomatch));
    }
    if (TRUELENGTH(s)>0) savetl(s);
    // as from v1.8.0 we assume R's internal hash is positive. So in R < 2.14.0 we
    // don't save the uninitialised truelengths that by chance are negative, but
    // will save if positive. Hence R >= 2.14.0 may be faster and preferred now that R
    // initializes truelength to 0 from R 2.14.0.
    SET_TRUELENGTH(s,0);
  }
  for (i=length(table)-1; i>=0; i--) {
    s = STRING_ELT(table,i);
    if (s != NA_STRING && ENC_KNOWN(s) != 64) { // changed !ENC_KNOWN(s) to !ASCII(s) - check above for explanation
      for (int j=i+1; j<LENGTH(table); j++) SET_TRUELENGTH(STRING_ELT(table,j),0);  // reinstate 0 rather than leave the -i-1
      savetl_end();
      UNPROTECT(1);
      return (in ? match_logical(table, x) : match(table, x, nomatch));
    }
    if (TRUELENGTH(s)>0) savetl(s);
    SET_TRUELENGTH(s, -i-1);
  }
  if (in) {
    for (i=0; i<length(x); i++) {
      LOGICAL(ans)[i] = TRUELENGTH(STRING_ELT(x,i))<0;
      // nomatch ignored for logical as base does I think
    }
  } else {
    for (i=0; i<length(x); i++) {
      m = TRUELENGTH(STRING_ELT(x,i));
      INTEGER(ans)[i] = (m<0) ? -m : nomatch;
    }
  }
  for (i=0; i<length(table); i++)
    SET_TRUELENGTH(STRING_ELT(table,i),0);  // reinstate 0 rather than leave the -i-1
  savetl_end();
  UNPROTECT(1);
  return(ans);
}

SEXP chmatchwrapper(SEXP x, SEXP table, SEXP nomatch, SEXP in) {
  return(chmatch(x,table,INTEGER(nomatch)[0],LOGICAL(in)[0]));
}

