swissChili | 8b5ec7a | 2022-08-05 22:26:17 -0700 | [diff] [blame] | 1 | #include "classes.h" |
| 2 | #include "../plat/plat.h" |
| 3 | #include "std.h" |
| 4 | |
| 5 | value_t *class_member_ref(value_t class, int index) |
| 6 | { |
| 7 | if (!classp(class)) |
| 8 | return NULL; |
| 9 | |
| 10 | struct class *c = (struct class *)(class ^ CLASS_TAG); |
| 11 | |
| 12 | if (index >= c->num_members) |
| 13 | return NULL; |
| 14 | |
| 15 | return &c->members[index]; |
| 16 | } |
| 17 | |
| 18 | value_t l_class_member(value_t class, value_t index) |
| 19 | { |
| 20 | if (!integerp(index)) |
| 21 | return nil; |
| 22 | |
| 23 | value_t *member = class_member_ref(class, valint(index)); |
| 24 | |
| 25 | if (member) |
| 26 | return *member; |
| 27 | else |
| 28 | return nil; |
| 29 | } |
| 30 | |
| 31 | value_t l_set_class_member(value_t class, value_t index, value_t value) |
| 32 | { |
| 33 | if (!integerp(index)) |
| 34 | return nil; |
| 35 | |
| 36 | value_t *member = class_member_ref(class, valint(index)); |
| 37 | |
| 38 | if (member) |
| 39 | *member = value; |
| 40 | |
| 41 | return nil; |
| 42 | } |
| 43 | |
| 44 | // type = symbol representing this instances type |
| 45 | // members = list of members |
| 46 | value_t l_make_class(value_t type, value_t members) |
| 47 | { |
| 48 | if (!integerp(members) || !symbolp(type)) |
| 49 | return nil; |
| 50 | |
| 51 | int nmemb = valint(members); |
| 52 | struct class_alloc *item = malloc_aligned(sizeof(struct class_alloc) + |
| 53 | sizeof(value_t) * nmemb); |
| 54 | struct class *c = &item->class; |
| 55 | |
| 56 | c->type = type; |
| 57 | c->num_members = nmemb; |
| 58 | c->cdata = NULL; |
| 59 | |
| 60 | for (int i = 0; i < nmemb; i++) |
| 61 | { |
| 62 | c->members[i] = nil; |
| 63 | } |
| 64 | |
| 65 | add_this_alloc(&item->alloc, CLASS_TAG); |
| 66 | |
| 67 | return (value_t)c | CLASS_TAG; |
| 68 | } |
| 69 | |
| 70 | void load_classes(struct environment *env) |
| 71 | { |
| 72 | add_c_function(env, "set-class-member", l_set_class_member, 3); |
| 73 | add_c_function(env, "class-member", l_class_member, 2); |
| 74 | add_c_function(env, "make-class", l_make_class, 2); |
| 75 | } |