#include "Mdefines.h"
#include "objects.h"

SEXP newObject(const char *what)
{
	SEXP class = PROTECT(R_do_MAKE_CLASS(what)), obj = R_do_new_object(class);
	UNPROTECT(1);
	return obj;
}

char typeToKind(SEXPTYPE type)
{
	switch (type) {
	case LGLSXP:
		return 'l';
	case INTSXP:
		return 'i';
	case REALSXP:
		return 'd';
	case CPLXSXP:
		return 'z';
	default:
		error(_("unexpected type \"%s\" in '%s'"), type2char(type), __func__);
		return '\0';
	}
}

SEXPTYPE kindToType(char kind)
{
	switch (kind) {
	case 'n':
	case 'l':
		return LGLSXP;
	case 'i':
		return INTSXP;
	case 'd':
		return REALSXP;
	case 'z':
		return CPLXSXP;
	default:
		error(_("unexpected kind \"%c\" in '%s'"), kind, __func__);
		return NILSXP;
	}
}

size_t kindToSize(char kind)
{
	switch (kind) {
	case 'n':
	case 'l':
	case 'i':
		return sizeof(int);
	case 'd':
		return sizeof(double);
	case 'z':
		return sizeof(Rcomplex);
	default:
		error(_("unexpected kind \"%c\" in '%s'"), kind, __func__);
		return 0;
	}
}

const char *Matrix_nonvirtual(SEXP obj, int strict)
{
	if (!isS4(obj))
		return "";
	static const char *valid[] = { VALID_NONVIRTUAL, "" };
	int ivalid = R_check_class_etc(obj, valid);
	if (ivalid < 0)
		return "";
	if (!strict)
		ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1);
	return valid[ivalid];
}

char Matrix_kind(SEXP obj)
{
	if (isS4(obj)) {
		static const char *valid[] = { VALID_NONVIRTUAL, "" };
		int ivalid = R_check_class_etc(obj, valid);
		if (ivalid < 0)
			return '\0';
		ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1);
		const char *cl = valid[ivalid];
		return (cl[2] == 'd') ? 'n' : cl[0];
	} else {
		switch (TYPEOF(obj)) {
		case LGLSXP:
			return 'l';
		case INTSXP:
			return 'i';
		case REALSXP:
			return 'd';
		case CPLXSXP:
			return 'z';
		default:
			return '\0';
		}
	}
}

char Matrix_shape(SEXP obj)
{
	if (!isS4(obj))
		return '\0';
	static const char *valid[] = { VALID_NONVIRTUAL, "" };
	int ivalid = R_check_class_etc(obj, valid);
	if (ivalid < 0)
		return '\0';
	ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1);
	const char *cl = valid[ivalid];
	return (cl[3] != 'M') ? 'g' : ((cl[2] == 'd') ? 'i' : cl[1]);
}

char Matrix_repr(SEXP obj)
{
	if (!isS4(obj))
		return '\0';
	static const char *valid[] = { VALID_NONVIRTUAL_MATRIX, "" };
	int ivalid = R_check_class_etc(obj, valid);
	if (ivalid < 0)
		return '\0';
	ivalid += VALID_NONVIRTUAL_SHIFT(ivalid, 1);
	const char *cl = valid[ivalid];
	switch (cl[2]) {
	case 'e':
	case 'y':
	case 'r':
		return 'u'; /* unpackedMatrix */
	case 'p':
		return 'p'; /*   packedMatrix */
	case 'C':
		return 'C'; /*  CsparseMatrix */
	case 'R':
		return 'R'; /*  RsparseMatrix */
	case 'T':
		return 'T'; /*  TsparseMatrix */
	case 'i':
		return 'd'; /* diagonalMatrix */
	case 'd':
		return 'i'; /*      indMatrix */
	default:
		return '\0';
	}
}

SEXP R_Matrix_nonvirtual(SEXP obj, SEXP strict)
{
	return mkString(Matrix_nonvirtual(obj, asLogical(strict)));
}

#define RETURN_AS_STRSXP(_C_) \
do { \
	char c = _C_; \
	if (!c) \
		return mkString(""); \
	else { \
		char s[] = { c, '\0' }; \
		return mkString(s); \
	} \
} while (0)

SEXP R_Matrix_kind(SEXP obj)
{
	RETURN_AS_STRSXP(Matrix_kind (obj));
}

SEXP R_Matrix_shape(SEXP obj)
{
	RETURN_AS_STRSXP(Matrix_shape(obj));
}

SEXP R_Matrix_repr(SEXP obj)
{
	RETURN_AS_STRSXP(Matrix_repr (obj));
}
