diff options
| -rw-r--r-- | lisplib.c | 2 | ||||
| -rw-r--r-- | share/txr/stdlib/struct.tl | 3 | ||||
| -rw-r--r-- | struct.c | 20 | ||||
| -rw-r--r-- | struct.h | 1 | ||||
| -rw-r--r-- | txr.1 | 50 |
5 files changed, 75 insertions, 1 deletions
@@ -174,7 +174,7 @@ static val struct_set_entries(val dlt, val fun) { val name[] = { lit("defstruct"), lit("qref"), lit("new"), lit("meth"), - lit("umeth"), lit("defmeth"), nil + lit("umeth"), lit("usl"), lit("defmeth"), nil }; set_dlt_entries(dlt, name, fun); diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl index 34e9bb07..5cbf3c83 100644 --- a/share/txr/stdlib/struct.tl +++ b/share/txr/stdlib/struct.tl @@ -191,6 +191,9 @@ (defmacro meth (obj slot) ^(method ,obj ',slot)) +(defmacro usl (slot) + ^(uslot ',slot)) + (defmacro umeth (slot) ^(umethod ',slot)) @@ -133,6 +133,7 @@ void struct_init(void) reg_fun(intern(lit("struct-type"), user_package), func_n1(struct_type)); reg_fun(intern(lit("method"), user_package), func_n2(method)); reg_fun(intern(lit("super-method"), user_package), func_n2(super_method)); + reg_fun(intern(lit("uslot"), user_package), func_n1(uslot)); reg_fun(intern(lit("umethod"), user_package), func_n1(umethod)); } @@ -791,6 +792,25 @@ val super_method(val strct, val slotsym) return func_f0v(cons(super_slot, strct), method_fun); } +static val uslot_fun(val sym, val strct) +{ + val self = lit("uslot"); + struct struct_inst *si = struct_handle(strct, self); + + if (symbolp(sym)) { + loc ptr = lookup_slot(strct, si, sym); + if (!nullocp(ptr)) + return deref(ptr); + } + + no_such_slot(self, si->type, sym); +} + +val uslot(val slot) +{ + return func_f1(slot, uslot_fun); +} + static val umethod_fun(val sym, struct args *args) { val self = lit("umethod"); @@ -47,5 +47,6 @@ val structp(val obj); val struct_type(val strct); val method(val strct, val slotsym); val super_method(val strct, val slotsym); +val uslot(val slot); val umethod(val slot); void struct_init(void); @@ -18829,6 +18829,29 @@ stands for "unbound". The function produced by is not bound to any specific object; it binds to an object whenever it is invoked by retrieving the actual method from the object's slot at call time. +.coNP Macro @ usl +.synb +.mets (usl << slot ) +.syne +.desc +The +.code usl +macro binds the symbol +.meta slot +to a function and returns that function. + +When that function is called, it expects exactly one argument. +That argument must be an object of struct type. +The slot named +.meta slot +is retrieved from that object and returned. + +The name +.code usl +stands for "unbound slot". The term "unbound" refers to the returned +function not being bound to a particular object. The binding of the +slot to an object takes place whenever the function is called. + .coNP Function @ make-struct-type .synb .mets (make-struct-type < name < super < static-slots < slots @@ -19318,6 +19341,33 @@ function, doesn't return a method whose leftmost argument is already bound to an object; the binding occurs at call time. +.coNP Function @ uslot +.synb +.mets (uslot << slot-name ) +.syne +.desc +The +.code uslot +returns a function which represents all slots named +.meta slot-name +in all structure types, including ones not yet defined. +The +.meta slot-name +argument must be a symbol. + +The returned function must be called with exactly one argument. +The argument must be a structure which has a slot named +.metn slot-name . +The function will retrieve the value of the slot from that object +and return it. + +Note: the +.code uslot +name stands for "unbound slot". The returned function +isn't bound to a particular object. The binding of +.code slot-name +to a slot in the structure object occurs when the function is called. + .coNP Function @ slotp .synb .mets (slotp < type << name ) |