/object.c

#include "blisp.h"

/*
 * Miscellaneous objects & type objects
 * Type, Nil, Empty list, Booleans
 */

/* locations of type, nil, empty list, and boolean objects and type objects */
Type Type_t;

Object Nil_o;
Type Nil_t;

Object Empty_o;
Type Empty_t;

Object True_o;
Object False_o;
Type Boolean_t;

/*
 * To-C-String char * strings
 * FIXME: Should these be static?
 */
/* Type header */
#define TH "type:"
char Type_Type_C_str[] = TH "type";
char Nil_Type_C_str[] = TH "nil";
char Empty_Type_C_str[] = TH "empty";
char Boolean_Type_C_str[] = TH "boolean";
char Number_Type_C_str[] = TH "number";
char String_Type_C_str[] = TH "string";
char Symbol_Type_C_str[] = TH "symbol";
char Pair_Type_C_str[] = TH "pair";
char Function_Type_C_str[] = TH "function";
#undef TH /* !type header */
char Invalid_Type_C_str[] = "INVALID-TYPE";
char Nil_C_str[] = "nil";
char Empty_C_str[] = "()";
char True_C_str[] = "#t";
char False_C_str[] = "#f";

/* Type */
SELF_EVAL_FUNC(Type)

char *Type_to_cstr(Object *o)
{
	Type *t = (Type *) o;
	char *s;

	if (t == TTYPE)
		s = Type_Type_C_str;
	else if (t == TNIL)
		s = Nil_Type_C_str;
	else if (t == TEMPTY)
		s = Empty_Type_C_str;
	else if (t == TBOOLEAN)
		s = Boolean_Type_C_str;
	else if (t == TNUMBER)
		s = Number_Type_C_str;
	else if (t == TSTRING)
		s = String_Type_C_str;
	else if (t == TSYMBOL)
		s = Symbol_Type_C_str;
	else if (t == TPAIR)
		s = Pair_Type_C_str;
	else if (t == TFUNCTION)
		s = Function_Type_C_str;
	else
	{
		int VALID_TYPE = 0;
		assert(VALID_TYPE); /* should fail in debug mode */
		s = Invalid_Type_C_str;
	}

	return s;
}

/* Nil */
SELF_EVAL_FUNC(Nil)

char *Nil_to_cstr(Object *o)
{
	return Nil_C_str;
}

/* Empty list */
SELF_EVAL_FUNC(Empty)

char *Empty_to_cstr(Object *o)
{
	return Empty_C_str;
}

/* Booleans */
SELF_EVAL_FUNC(Boolean)

char *Boolean_to_cstr(Object *o)
{
	if (getboolean(o))
		return True_C_str;
	else
		return False_C_str;
}

/* Equals functions */
/*
Object *Equal_p(Object *o1, Object *o2)
{
	/=*
	EqualFunc equal_p = gettype(o1)->equal;
	if (equal_p == NULL) return Eq_p(o1, o2);
	return equal_p(o1, o2);
	*=/
	return gettype(o1)->equal(o1, o2);
}
*/

Object *Type_equal(Object *o1, Object *o2)
{
	return Eq_p(o1, o2);
}

Object *Nil_equal(Object *o1, Object *o2)
{
	return Eq_p(o1, o2);
}

Object *Empty_equal(Object *o1, Object *o2)
{
	return Eq_p(o1, o2);
}

Object *Boolean_equal(Object *o1, Object *o2)
{
	return Eq_p(o1, o2);
}

/*
 * Fold/reduce left algorithms
 * Rather important ones for a functional-ish programming language
 * based around lists :)
 * The "c" means it takes and uses a C function pointer
 */
Object *cfold_left(BinaryFunc func, Object *first, Object *list)
{
	Object *acc; /* accumulator */

	/* Only act if it is a proper list */
	if (!list_p(list))
		return ONIL;

	acc = first;
	
	while (pair_p(list))
	{
		acc = func(acc, Head(list));
		list = Tail(list);
	}

	return acc;
}

/*
 * Take a binary C function and a list and reduce the list to a single value
 *
 * If there is only 1 item in the list, return it
 */
Object *cfold_left_no_init(BinaryFunc func, Object *list)
{
	if (!pair_p(list))
		return ONIL;

	return cfold_left(func, Head(list), Tail(list));
}

/*
 * Is "o" a proper list?
 *
 * Def:
 * 	If o is () -> True
 * 	Else if o is Pair -> repeat on tail
 * 	Else -> False
 */
/*
int list_p(Object *o)
{
	Object *cur = o;

	while (pair_p(cur))
	{
		cur = Tail(cur);
	}

	if (empty_p(cur))
		return CTRUE;
	else
		return CFALSE;
}
*/

/*
 * Starting with 0, increment for every new pair.
 * If first non-pair is "()" (for a proper list), return the accumulator.
 * Else, return (-1) for error.
 *
 * Follows closely the format of "list_p".
 */
int list_length(Object *o)
{
	Object *cur = o;
	int acc = 0;
	
	while (pair_p(cur))
	{
		acc++;
		cur = Tail(cur);
	}
	
	if (empty_p(cur))
		return acc;
	else
		return (-1);
}