typedef enum ObjectType { OBJ_TYPE_FIXNUM, OBJ_TYPE_BOOL, OBJ_TYPE_NIL, OBJ_TYPE_SYMBOL, OBJ_TYPE_STRING, OBJ_TYPE_PAIR, OBJ_TYPE_PROCEDURE, OBJ_TYPE_LAMBDA, OBJ_TYPE_ERR, } ObjectType; struct Environment; typedef struct Object { ObjectType type; union { // OBJ_TYPE_FIXNUM ssize_t fixnum; // OBJ_TYPE_STRING struct { char *string; size_t string_n; }; // OBJ_TYPE_PAIR struct { struct Object *car; struct Object *cdr; }; // OBJ_TYPE_SYMBOL struct { char *symbol; size_t symbol_n; }; // OBJ_TYPE_PROCEDURE struct Object *(*proc)(struct Environment *env, struct Object *args); // OBJ_TYPE_LAMBDA struct { struct Object *params; struct Object *body; struct Environment *env; }; }; } Object; // // Singletons. // static Object *obj_nil; static Object *obj_true; static Object *obj_false; static Object *obj_err; // // Constructors. // Object * alloc_object(ObjectType type) { Object *obj = malloc(sizeof(Object)); obj->type = type; return obj; } Object * make_fixnum(ssize_t num) { Object *obj = alloc_object(OBJ_TYPE_FIXNUM); obj->fixnum = num; return obj; } Object * make_procedure(Object *(*proc)(struct Environment *, struct Object *args)) { Object *obj = alloc_object(OBJ_TYPE_PROCEDURE); obj->proc = proc; return obj; } Object * make_pair(Object *car, Object *cdr) { Object *obj = alloc_object(OBJ_TYPE_PAIR); obj->car = car; obj->cdr = cdr; return obj; } Object * make_symbol(StringView sv) { Object *obj = alloc_object(OBJ_TYPE_SYMBOL); obj->symbol = malloc(sizeof(char) * sv.n); memcpy(obj->symbol, sv.start, sv.n); obj->symbol_n = sv.n; return obj; } Object * make_string(void) { Object *obj = alloc_object(OBJ_TYPE_STRING); obj->string = NULL; obj->string_n = 0; return obj; } void append_string(Object *obj, const StringView sv) { assert(obj != NULL); assert(obj->type == OBJ_TYPE_STRING); if (sv.n == 0) { return; } obj->string = realloc(obj->string, (obj->string_n + sv.n) * sizeof(char)); memcpy(obj->string + obj->string_n, sv.start, sv.n); obj->string_n += sv.n; } Object * obj_duplicate(Object *obj) { Object *copy = obj_err; switch (obj->type) { case OBJ_TYPE_BOOL: case OBJ_TYPE_NIL: case OBJ_TYPE_PROCEDURE: case OBJ_TYPE_LAMBDA: // TODO: should we duplicate everything inside? case OBJ_TYPE_ERR: { copy = obj; } break; case OBJ_TYPE_FIXNUM: { copy = make_fixnum(obj->fixnum); } break; case OBJ_TYPE_SYMBOL: { copy = make_symbol((StringView){obj->symbol, obj->symbol_n}); } break; case OBJ_TYPE_STRING: { copy = make_string(); append_string(copy, (StringView){obj->string, obj->string_n}); } break; case OBJ_TYPE_PAIR: { Object *root = make_pair(obj_duplicate(obj->car), obj_nil); copy = root; obj = obj->cdr; while (obj != obj_nil) { root->cdr = make_pair(obj_duplicate(obj->car), obj_nil); root = root->cdr; obj = obj->cdr; } } break; } return copy; } void free_objects(Object *root) { switch (root->type) { case OBJ_TYPE_BOOL: break; case OBJ_TYPE_NIL: break; case OBJ_TYPE_ERR: break; case OBJ_TYPE_PROCEDURE: case OBJ_TYPE_FIXNUM: { free(root); } break; case OBJ_TYPE_SYMBOL: { if (root->symbol != NULL) { free(root->symbol); } free(root); } break; case OBJ_TYPE_STRING: { if (root->string != NULL) { free(root->string); } free(root); } break; case OBJ_TYPE_PAIR: { if (root->car != NULL) { free_objects(root->car); } if (root->cdr != NULL) { free_objects(root->cdr); } free(root); } break; case OBJ_TYPE_LAMBDA: { free_objects(root->params); free_objects(root->body); // TODO: free_env(root->env); free(root); } break; } } void display(Object *root); void display_pair(Object *root) { display(root->car); if (root->cdr->type == OBJ_TYPE_PAIR) { printf(" "); display_pair(root->cdr); } else if (root->cdr == obj_nil) { return; } else { printf(" . "); display(root->cdr); } } void display(Object *root) { switch (root->type) { case OBJ_TYPE_FIXNUM: { printf("%zd", root->fixnum); } break; case OBJ_TYPE_BOOL: { if (root == obj_true) { printf("true"); } else { printf("false"); } } break; case OBJ_TYPE_NIL: { printf("()"); } break; case OBJ_TYPE_STRING: { printf("\"%.*s\"", (int)root->string_n, root->string); } break; case OBJ_TYPE_SYMBOL: { printf(":%.*s", (int)root->symbol_n, root->symbol); } break; case OBJ_TYPE_PAIR: { printf("("); display_pair(root); printf(")"); } break; case OBJ_TYPE_LAMBDA: case OBJ_TYPE_PROCEDURE: { printf("#{procedure}"); } break; case OBJ_TYPE_ERR: { printf("#{error}"); } break; } return; } bool obj_eq(Object *a, Object* b) { if (a->type != b->type) { return false; } switch (a->type) { case OBJ_TYPE_FIXNUM: { return a->fixnum == b->fixnum; } break; case OBJ_TYPE_STRING: { if (a->string_n != b->string_n) { return false; } for (size_t i = 0; i < a->string_n; i++) { if (a->string[i] != b->string[i]) { return false; } } } break; case OBJ_TYPE_SYMBOL: { if (a->symbol_n != b->symbol_n) { return false; } for (size_t i = 0; i < a->symbol_n; i++) { if (a->symbol[i] != b->symbol[i]) { return false; } } } break; default: { return a == b; } break; } return true; }