#include "builtins.h" #include #include #include #include #include struct Builtin { const char *name; struct Object *(*func)(struct Object *args); }; // Evaluation static struct Object *func_eval(struct Object *args); // Basic data structures static struct Object *func_cons(struct Object *args); static struct Object *func_quote(struct Object *args); // Type predicates static struct Object *func_booleanQN(struct Object *args); static struct Object *func_charQN(struct Object *args); static struct Object *func_nullQN(struct Object *args); static struct Object *func_numberQN(struct Object *args); static struct Object *func_pairQN(struct Object *args); static struct Object *func_stringQN(struct Object *args); static struct Object *func_symbolQN(struct Object *args); // Logical operators static struct Object *func_and(struct Object *args); static struct Object *func_or(struct Object *args); // IO static struct Object *func_display(struct Object *args); static struct Object *func_displayln(struct Object *args); static struct Object *func_newline(struct Object *args); // Other static struct Object *func_sum(struct Object *args); static struct Builtin builtins[] = { // Evaluation { "eval", func_eval }, // Basic data structures { "cons", func_cons }, { "quote", func_quote }, // Type predicates { "boolean?", func_booleanQN }, { "char?", func_charQN }, { "null?", func_nullQN }, { "number?", func_numberQN }, { "pair?", func_pairQN }, { "string?", func_stringQN }, { "symbol?", func_symbolQN }, // Logical operators { "and", func_and }, { "or", func_or }, // IO { "display", func_display }, { "displayln", func_displayln }, { "newline", func_newline }, // Other { "+", func_sum }, { NULL, NULL }, }; static struct Object *builtins_call(const char *name, struct Object *args) { for (size_t index = 0; builtins[index].name; ++index) { if (strcmp(builtins[index].name, name) == 0) { return builtins[index].func(args); } } abort(); } struct Object *builtins_eval(struct Object *program) { // NULL is an empty list, can't eval assert(program); // Almost everything evaluates to itself if (program->type != TYPE_PAIR && program->type != TYPE_SYMBOL) { return program; } // Symbols are variable names, but we can't lookup assert(program->type != TYPE_SYMBOL); // The first item of pair should be an symbol - a function name assert(program->pair.a && program->pair.a->type == TYPE_SYMBOL); return builtins_call(program->pair.a->s, program->pair.b); } /************** * Evaluation * **************/ struct Object *func_eval(struct Object *const args) { assert(args); assert(args->type == TYPE_PAIR); assert(args->pair.b == NULL); return builtins_eval(args->pair.a); } /************************* * Basic data structures * *************************/ struct Object *func_cons(struct Object *const args) { assert(args); assert(args->type == TYPE_PAIR); assert(args->pair.a); assert(args->pair.b); assert(args->pair.b->type == TYPE_PAIR); assert(args->pair.b->pair.a); assert(args->pair.b->pair.b == NULL); struct Object *const car = builtins_eval(args->pair.a); struct Object *const cdr = builtins_eval(args->pair.b->pair.a); return Object_new_pair(car, cdr); } struct Object *func_quote(struct Object *const args) { if (!args) return NULL; assert(args->type == TYPE_PAIR); assert(args->pair.b == NULL); return args->pair.a; } /******************* * Type predicates * *******************/ struct Object *func_booleanQN(struct Object *args) { assert(args); assert(args->type == TYPE_PAIR); assert(args->pair.b == NULL); struct Object *const object = builtins_eval(args->pair.a); return Object_new_boolean(object && object->type == TYPE_BOOLEAN); } struct Object *func_charQN(struct Object *args) { assert(args); assert(args->type == TYPE_PAIR); assert(args->pair.b == NULL); struct Object *const object = builtins_eval(args->pair.a); return Object_new_boolean(object && object->type == TYPE_CHAR); } struct Object *func_nullQN(struct Object *args) { assert(args); assert(args->type == TYPE_PAIR); assert(args->pair.b == NULL); struct Object *const object = builtins_eval(args->pair.a); return Object_new_boolean(object == NULL); } struct Object *func_numberQN(struct Object *args) { assert(args); assert(args->type == TYPE_PAIR); assert(args->pair.b == NULL); struct Object *const object = builtins_eval(args->pair.a); return Object_new_boolean(object && object->type == TYPE_NUMBER); } struct Object *func_pairQN(struct Object *args) { assert(args); assert(args->type == TYPE_PAIR); assert(args->pair.b == NULL); struct Object *const object = builtins_eval(args->pair.a); return Object_new_boolean(object && object->type == TYPE_PAIR); } struct Object *func_stringQN(struct Object *args) { assert(args); assert(args->type == TYPE_PAIR); assert(args->pair.b == NULL); struct Object *const object = builtins_eval(args->pair.a); return Object_new_boolean(object && object->type == TYPE_STRING); } struct Object *func_symbolQN(struct Object *args) { assert(args); assert(args->type == TYPE_PAIR); assert(args->pair.b == NULL); struct Object *const object = builtins_eval(args->pair.a); return Object_new_boolean(object && object->type == TYPE_SYMBOL); } /********************* * Logical operators * *********************/ struct Object *func_and(struct Object *args) { struct Object *result = Object_new_boolean(true); while (args) { assert(args->type == TYPE_PAIR); result = builtins_eval(args->pair.a); if (IS_FALSE(result)) break; args = args->pair.b; } return result; } struct Object *func_or(struct Object *args) { struct Object *result = Object_new_boolean(false); while (args) { assert(args->type == TYPE_PAIR); result = builtins_eval(args->pair.a); if (!IS_FALSE(result)) break; args = args->pair.b; } return result; } /****** * IO * ******/ static void display_pair(struct Object *pair); struct Object *func_display(struct Object *const args) { assert(args); assert(args->type == TYPE_PAIR); assert(args->pair.b == NULL); struct Object *const object = builtins_eval(args->pair.a); if (!object) { printf("()"); return NULL; } switch (object->type) { case TYPE_PROCEDURE: if (object->procedure.name) { printf("#", object->procedure.name); } else { printf("#"); } break; case TYPE_PAIR: printf("("); display_pair(object); printf(")"); break; case TYPE_BOOLEAN: printf("%s", object->boolean ? "#t" : "#f"); break; case TYPE_CHAR: printf("#\\TODO"); // TODO break; case TYPE_SYMBOL: case TYPE_STRING: printf("%s", object->s); break; case TYPE_NUMBER: printf("%li", object->i); break; } return NULL; } struct Object *func_displayln(struct Object *const args) { func_display(args); func_newline(NULL); return NULL; } struct Object *func_newline(struct Object *const args) { assert(args == NULL); printf("\n"); return NULL; } void display_pair(struct Object *const pair) { assert(pair); assert(pair->type == TYPE_PAIR); func_display(Object_new_pair(pair->pair.a, NULL)); if (!pair->pair.b) return; printf(" "); if (pair->pair.b->type == TYPE_PAIR) { display_pair(pair->pair.b); return; } printf(". "); func_display(Object_new_pair(pair->pair.b, NULL)); } /********* * Other * *********/ struct Object *func_sum(struct Object *const args) { struct Object *const object = Object_new_number(0); if (!args) return object; assert(args->type == TYPE_PAIR); assert(args->pair.a); assert(args->pair.a->type == TYPE_NUMBER); object->i = args->pair.a->i; if (!args->pair.b) return object; struct Object *const b_sum = func_sum(args->pair.b); object->i += b_sum->i; return object; }