/v2/object.c
C | 236 lines | 134 code | 33 blank | 69 comment | 37 complexity | 55989894c7c6bd479047648e0b5e632b MD5 | raw file
- #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:"
- const char *Type_Type_C_str = TH "type";
- const char *Nil_Type_C_str = TH "nil";
- const char *Empty_Type_C_str = TH "empty";
- const char *Boolean_Type_C_str = TH "boolean";
- const char *Number_Type_C_str = TH "number";
- const char *String_Type_C_str = TH "string";
- const char *Symbol_Type_C_str = TH "symbol";
- const char *Pair_Type_C_str = TH "pair";
- const char *Function_Type_C_str = TH "function";
- #undef TH /* !type header */
- const char *Invalid_Type_C_str = "INVALID-TYPE";
- const char *Nil_C_str = "nil";
- const char *Empty_C_str = "()";
- const char *True_C_str = "#t";
- const char *False_C_str = "#f";
- /* Type */
- SELF_EVAL_FUNC(Type)
- const char *Type_to_cstr(Object *o)
- {
- Type *t = (Type *) o;
- const 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)
- const char *Nil_to_cstr(Object *o)
- {
- return Nil_C_str;
- }
- /* Empty list */
- SELF_EVAL_FUNC(Empty)
- const char *Empty_to_cstr(Object *o)
- {
- return Empty_C_str;
- }
- /* Booleans */
- SELF_EVAL_FUNC(Boolean)
- const 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));
- }
- Object *cfold_right(BinaryFunc *func, Object *first, Object *list)
- {
- if (!list_p(list)) return ONIL;
- if (pair_p(list))
- {
- Object *tail = Tail(list);
- Object *next = cfold_right(func, Head(tail), Tail(tail));
- return (*func)(first, next);
- }
- else if (empty_p(list)) return first;
- else return ONIL;
- }
- /*
- * 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);
- }