diff options
| -rw-r--r-- | struct.c | 50 | ||||
| -rw-r--r-- | struct.h | 4 | ||||
| -rw-r--r-- | tests/012/oop.tl | 36 | ||||
| -rw-r--r-- | txr.1 | 76 |
4 files changed, 158 insertions, 8 deletions
@@ -105,7 +105,7 @@ struct struct_inst { val struct_type_s, meth_s, print_s, make_struct_lit_s; val init_k, postinit_k; -val slot_s, derived_s; +val slot_s, slotset_s, static_slot_s, static_slot_set_s, derived_s; val copy_s, nullify_s, from_list_s, lambda_set_s; @@ -115,7 +115,7 @@ static val *special_sym[num_special_slots] = { &equal_s, ©_s, &nullify_s, &from_list_s, &lambda_s, &lambda_set_s, &length_s, &length_lt_s, &car_s, &cdr_s, &rplaca_s, &rplacd_s, &iter_begin_s, &iter_more_s, &iter_item_s, &iter_step_s, &iter_reset_s, - &plus_s + &plus_s, &slot_s, &slotset_s, &static_slot_s, &static_slot_set_s }; static struct cobj_class *struct_type_cls; @@ -148,6 +148,9 @@ void struct_init(void) init_k = intern(lit("init"), keyword_package); postinit_k = intern(lit("postinit"), keyword_package); slot_s = intern(lit("slot"), user_package); + slotset_s = intern(lit("slotset"), user_package); + static_slot_s = intern(lit("static-slot"), user_package); + static_slot_set_s = intern(lit("static-slot-set"), user_package); derived_s = intern(lit("derived"), user_package); copy_s = intern(lit("copy"), user_package); nullify_s = intern(lit("nullify"), user_package); @@ -193,10 +196,9 @@ void struct_init(void) reg_fun(intern(lit("clear-struct"), user_package), func_n2o(clear_struct, 1)); reg_fun(intern(lit("reset-struct"), user_package), func_n1(reset_struct)); reg_fun(slot_s, func_n2(slot)); - reg_fun(intern(lit("slotset"), user_package), func_n3(slotset)); - reg_fun(intern(lit("static-slot"), user_package), func_n2(static_slot)); - reg_fun(intern(lit("static-slot-set"), user_package), - func_n3(static_slot_set)); + reg_fun(slotset_s, func_n3(slotset)); + reg_fun(static_slot_s, func_n2(static_slot)); + reg_fun(static_slot_set_s, func_n3(static_slot_set)); reg_fun(intern(lit("test-dirty"), user_package), func_n1(test_dirty)); reg_fun(intern(lit("test-clear-dirty"), user_package), func_n1(test_clear_dirty)); reg_fun(intern(lit("clear-dirty"), user_package), func_n1(clear_dirty)); @@ -1275,6 +1277,13 @@ val slot(val strct, val sym) return deref(ptr); } + { + val slot_meth = get_special_slot(strct, slot_m); + + if (slot_meth) + return funcall2(slot_meth, strct, sym); + } + no_such_slot(self, si->type->self, sym); } @@ -1289,6 +1298,13 @@ val maybe_slot(val strct, val sym) return deref(ptr); } + { + val slot_meth = get_special_slot(strct, slot_m); + + if (slot_meth) + return funcall2(slot_meth, strct, sym); + } + return nil; } @@ -1311,6 +1327,13 @@ val slotset(val strct, val sym, val newval) } } + { + val slotset_meth = get_special_slot(strct, slotset_m); + + if (slotset_meth) + return funcall3(slotset_meth, strct, sym, newval); + } + no_such_slot(self, si->type->self, sym); } @@ -1325,6 +1348,13 @@ val static_slot(val stype, val sym) return deref(ptr); } + { + val static_slot_meth = get_special_slot_by_type(st->self, static_slot_m); + + if (static_slot_meth) + return funcall2(static_slot_meth, st->self, sym); + } + no_such_static_slot(self, stype, sym); } @@ -1341,6 +1371,14 @@ val static_slot_set(val stype, val sym, val newval) } } + { + val static_slot_set_meth = get_special_slot_by_type(st->self, + static_slot_set_m); + + if (static_slot_set_meth) + return funcall3(static_slot_set_meth, st->self, sym, newval); + } + no_such_static_slot(self, stype, sym); } @@ -28,7 +28,7 @@ extern val struct_type_s, meth_s, print_s, make_struct_lit_s; extern val init_k, postinit_k; -extern val slot_s, derived_s; +extern val slot_s, slotset_s, static_slot_s, static_slot_set_s, derived_s; extern val lambda_set_s; extern val iter_begin_s, iter_more_s, iter_item_s, iter_step_s, iter_reset_s; @@ -39,7 +39,7 @@ enum special_slot { equal_m, copy_m, nullify_m, from_list_m, lambda_m, lambda_set_m, length_m, length_lt_m, car_m, cdr_m, rplaca_m, rplacd_m, iter_begin_m, iter_more_m, iter_item_m, iter_step_m, iter_reset_m, - plus_m, + plus_m, slot_m, slotset_m, static_slot_m, static_slot_set_m, num_special_slots }; diff --git a/tests/012/oop.tl b/tests/012/oop.tl index 8bf8b4b4..7633b645 100644 --- a/tests/012/oop.tl +++ b/tests/012/oop.tl @@ -159,3 +159,39 @@ (new node left (succ me.left) right (succ me.right))) (test (copy (new node left 1 right 2)) #S(node left 2 right 3)) + +(defstruct cust-slots () + a + (:method slot (me slot) ^(slot ,slot)) + (:method slotset (me slot new) ^(slotset ,slot ,new)) + (:function static-slot (type slot) ^(static-slot ,slot)) + (:function static-slot-set (type slot new) ^(static-slot-set ,slot ,new))) + +(defstruct no-cust-slots () + a) + +(defstruct get-type () + (:function static-slot (type slot) type) + (:function static-slot-set (type slot new) type)) + +(let ((o (new cust-slots))) + (mtest + o.a nil + o.b (slot b) + (set o.b 3) (slotset b 3) + (static-slot 'cust-slots 'b) (static-slot b) + (static-slot-set 'cust-slots 'b 3) (static-slot-set b 3))) + +(let ((o (new no-cust-slots))) + (mtest + o.a nil + o.b :error + (set o.b 3) :error + (static-slot 'no-cust-slots 'b) :error + (static-slot-set 'no-cust-slots 'b 3) :error)) + +(mvtest + (static-slot 'get-type 'b) (find-struct-type 'get-type) + (static-slot (find-struct-type 'get-type) 'b) (find-struct-type 'get-type) + (static-slot-set 'get-type 'b 3) (find-struct-type 'get-type) + (static-slot-set (find-struct-type 'get-type) 'b 3) (find-struct-type 'get-type)) @@ -33631,6 +33631,82 @@ any output output pertaining to .metn object 's representation. +.coNP Methods @ slot and @ slot-set +.synb +.mets << object .(slot << slot-name ) +.mets << object .(slot-set < slot-name << new-value ) +.syne +.desc +Defining these methods allows a struct type to handle the situation +when a nonexistent slot is accessed. + +The +.code slot +method, if it exists, is invoked if a slot named +.meta slot-name +is accessed by the +.code slot +function, or equivalent syntax, and that slot does not exist. +The value returned by the method is taken to be the nonexistent +slot's value. + +When a value is stored in a slot named +.meta slot-name +by the +.code slotset +function, or equivalent syntax, and the slot does not exist, then the +.code slotset +method is invoked, if it exists. +It is recommended that the +.code slotset +function return +.metn new-value , +since the value returned propagates out of the +.code slotset +function, which in all other cases returns +.metn new-value , +which is important to the implementation of syntactic places +that designate slots. + +.coNP Functions @ static-slot and @ static-slot-set +.synb +.mets << object .[static-slot < type << slot-name ) +.mets << object .[static-slot-set < type < slot-name << new-value ) +.syne +.desc +The +.code static-slot +and +.code static-slot-set +functions are analogous to the +.code slot +and +.codn slotset , +methods. These functions, if they exist, are only invoked +when a static slot lookup fails. Static slot lookups occur through the +.code static-slot +and +.code static-slot-set +functions, which can be used directly and are used in certain +situations. For instance when +.code "(meth ...)" +syntax is looked up with +.codn symbol-function , +static slot lookup is used. It is recommended that for simulating the +existence of structure functions and methods, these methods be used. + +The +.metn type , +argument is an object of type +.code struct-type +giving the structure type on which the static slot lookup is taking +place. + +It is recommended that the +.code static-slot-set +function return +.metn new-value . + .coNP Method @ lambda .synb .mets << object .(lambda << arg *) |