From 3cad8dfa357c5733c94e2a301da9184f3eb50e78 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 14 Nov 2015 20:54:00 -0800
Subject: New uslot function and usl macro.

* struct.c (struct_init): Register uslot intrinsic function.
(uslot_fun): New static function.
(uslot): New function.

* struct.h (uslot): Declared.

* share/txr/stdlib/struct.tl (usl): New macro.

* lisplib.c (struct_set_entries): Add usl macro.

* txr.1: Documented uslot and usl.
---
 lisplib.c                  |  2 +-
 share/txr/stdlib/struct.tl |  3 +++
 struct.c                   | 20 +++++++++++++++++++
 struct.h                   |  1 +
 txr.1                      | 50 ++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 75 insertions(+), 1 deletion(-)

diff --git a/lisplib.c b/lisplib.c
index 46d99305..b33018da 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -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))
 
diff --git a/struct.c b/struct.c
index 040b43be..acd28f68 100644
--- a/struct.c
+++ b/struct.c
@@ -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");
diff --git a/struct.h b/struct.h
index 88f5a1c6..d5545bf4 100644
--- a/struct.h
+++ b/struct.h
@@ -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);
diff --git a/txr.1 b/txr.1
index 7154bc11..65748eb3 100644
--- a/txr.1
+++ b/txr.1
@@ -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 )
-- 
cgit v1.2.3