Warn when a nonexistent slot is referenced.

Implementing warning for the situaton when the qref, uref, usl
and umeth macro operators are asked to refer to a slot that
doesn't exist in any struct type. This won't catch errors
referencing a slot on the wrong type, but it will catch slots
that are misspelled in such a way that the typo doesn't land
on any slot.

* share/txr/stdlib/struct.tl (defstruct): Register tenative
slot definitions for all slots to nuke warnings.
(sys:check-slot): New function.
(qref, usl, umeth): Check slots with sys:check-slot.
(uref): Drop :whole argument, which is unused.
(defmeth): Register tentative definition for slot.

* struct.c (slot_s, static_slot_s): New symbol variables.
(slot_type_hash, static_slot_type_hash): New hash tables,
associating symbols with lists of struct type names
in which they are defined.
(struct_init): Initialize and gc-protect hashes.
Initialize new symbols, interning in system package.
Register new intrinsic funtions sys:slot-types and
sys:static-slot-types.
(make_struct_type): Register slots in new hashes.
(static_slot_ens_rec): Register new slow in static
slot hash.
(slot_types, static_slot_types): New functions,
registered as intrinsics.
(slot_type_reg, static_slot_type_reg): New functions.

* struct.h (print_s): Declared.
(slot_s, static_slot_s): Declared.
(slot_types, static_slot_types, slot_type_reg,
static_slot_type_reg): Declared.

3 files changed, 89 insertions, 10 deletions

diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index 7de81ae9..3605e7ee 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -136,6 +136,10 @@
       (let ((arg-sym (gensym))
             (type-sym (gensym)))
         (register-tentative-def ^(struct-type . ,name))
+        (each ((s stat-slots))
+          (register-tentative-def ^(sys:slot . ,s)))
+        (each ((s inst-slots))
+          (register-tentative-def ^(sys:slot . ,s)))
         ^(sys:make-struct-type
            ',name ',super ',stat-slots ',inst-slots
            ,(if (or func-si-forms val-si-forms)
@@ -186,28 +190,46 @@
 (defmacro sys:struct-lit (name . plist)
   ^(sys:make-struct-lit ',name ',plist))
 
-(defmacro qref (:whole form obj . refs)
+(defun sys:check-slot (form slot)
+  (unless (or (sys:slot-types slot)
+              (sys:static-slot-types slot))
+    (compile-defr-warning form ^(sys:slot . ,slot)
+                          "symbol ~s isn't the name of a struct slot"
+                          slot))
+  slot)
+
+(defmacro qref (:form form obj . refs)
   (when (null refs)
     (throwf 'eval-error "~s: bad syntax" 'qref))
   (tree-case refs
     (() ())
     (((dw sym . args))
-     (if (eq dw 'dwim) ^[(slot ,obj ',sym) ,*args] :))
+     (if (eq dw 'dwim)
+       ^[(slot ,obj ',(sys:check-slot form sym)) ,*args]
+       :))
     (((dw sym . args) . more)
-     (if (eq dw 'dwim) ^(qref [(slot ,obj ',sym) ,*args] ,*more) :))
+     (if (eq dw 'dwim)
+       ^(qref [(slot ,obj ',(sys:check-slot form sym)) ,*args] ,*more)
+       :))
     (((sym . args))
      (let ((osym (gensym)))
+       (sys:check-slot form sym)
        ^(slet ((,osym ,obj))
           (call (slot ,osym ',sym) ,osym ,*args))))
     (((sym . args) . more)
      (let ((osym (gensym)))
+       (sys:check-slot form sym)
        ^(qref (slet ((,osym ,obj))
                 (call (slot ,osym ',sym) ,osym ,*args)) ,*more)))
-    ((sym) ^(slot ,obj ',sym))
-    ((sym . more) ^(qref (slot ,obj ',sym) ,*more))
+    ((sym)
+     (sys:check-slot form sym)
+     ^(slot ,obj ',sym))
+    ((sym . more)
+     (sys:check-slot form sym)
+     ^(qref (slot ,obj ',sym) ,*more))
     (obj (throwf 'eval-error "~s: bad syntax: ~s" 'qref refs))))
 
-(defmacro uref (:whole form . args)
+(defmacro uref (. args)
   (cond
     ((null args) (throwf 'eval-error "~s: bad syntax" 'uref))
     ((null (cdr args))
@@ -241,10 +263,12 @@
 (defmacro meth (obj slot . bound-args)
   ^[(fun method) ,obj ',slot ,*bound-args])
 
-(defmacro usl (slot)
+(defmacro usl (:form form slot)
+  (sys:check-slot form slot)
   ^(uslot ',slot))
 
-(defmacro umeth (slot . bound-args)
+(defmacro umeth (:form form slot . bound-args)
+  (sys:check-slot form slot)
   ^[(fun umethod) ',slot ,*bound-args])
 
 (defun sys:defmeth (type-sym name fun)
@@ -258,6 +282,7 @@
     ((not (find-struct-type type-sym))
       (compile-defr-warning form ^(struct-type . ,type-sym)
                             "definition of struct ~s not seen here" type-sym)))
+  (register-tentative-def ^(sys:slot . ,name))
   ^(sys:defmeth ',type-sym ',name (lambda ,arglist
                                     (block ,name ,*body))))
 
diff --git a/struct.c b/struct.c
index 57870980..46b1bcab 100644
--- a/struct.c
+++ b/struct.c
@@ -90,11 +90,14 @@ struct struct_inst {
 };
 
 val struct_type_s, meth_s, print_s, make_struct_lit_s;
+val slot_s, static_slot_s;
 
 static cnum struct_id_counter;
 static val struct_type_hash;
 static val slot_hash;
 static val struct_type_finalize_f;
+static val slot_type_hash;
+static val static_slot_type_hash;
 
 static val struct_type_finalize(val obj);
 static_forward(struct cobj_ops struct_type_ops);
@@ -107,14 +110,20 @@ static val call_super_fun(val type, val sym, struct args *);
 
 void struct_init(void)
 {
-  protect(&struct_type_hash, &slot_hash, &struct_type_finalize_f,
+  protect(&struct_type_hash, &slot_hash, &slot_type_hash,
+          &static_slot_type_hash, &struct_type_finalize_f,
           convert(val *, 0));
   struct_type_s = intern(lit("struct-type"), user_package);
   meth_s = intern(lit("meth"), user_package);
   print_s = intern(lit("print"), user_package);
   make_struct_lit_s = intern(lit("make-struct-lit"), system_package);
+  slot_s = intern(lit("slot"), system_package);
+  static_slot_s = intern(lit("static-slot"), system_package);
   struct_type_hash = make_hash(nil, nil, nil);
   slot_hash = make_hash(nil, nil, t);
+  slot_type_hash = make_hash(nil, nil, nil);
+  slot_type_hash = make_hash(nil, nil, nil);
+  static_slot_type_hash = make_hash(nil, nil, nil);
   struct_type_finalize_f = func_n1(struct_type_finalize);
 
   if (opt_compat && opt_compat <= 117)
@@ -167,6 +176,8 @@ void struct_init(void)
   reg_fun(intern(lit("uslot"), user_package), func_n1(uslot));
   reg_fun(intern(lit("umethod"), user_package), func_n1v(umethod));
   reg_fun(intern(lit("slots"), user_package), func_n1(slots));
+  reg_fun(intern(lit("slot-types"), system_package), func_n1(slot_types));
+  reg_fun(intern(lit("static-slot-types"), system_package), func_n1(static_slot_types));
 }
 
 static noreturn void no_such_struct(val ctx, val sym)
@@ -326,8 +337,10 @@ val make_struct_type(val name, val super,
           ss->store = nil;
         }
         sethash(slot_hash, cons(slot, id), num(n + STATIC_SLOT_BASE));
+        static_slot_type_reg(slot, name);
       } else {
         sethash(slot_hash, cons(slot, id), num_fast(sl++));
+        slot_type_reg(slot, name);
       }
 
       if (sl >= STATIC_SLOT_BASE)
@@ -1103,6 +1116,7 @@ static val static_slot_ens_rec(val stype, val sym, val newval,
 
     sethash(slot_hash, cons(sym, num_fast(st->id)),
             num(st->nstslots++ + STATIC_SLOT_BASE));
+    static_slot_type_reg(sym, st->name);
   }
 
   {
@@ -1545,6 +1559,41 @@ val get_slot_syms(val package, val is_current, val method_only)
   return result_hash;
 }
 
+val slot_types(val slot)
+{
+  return gethash(slot_type_hash, slot);
+}
+
+val static_slot_types(val slot)
+{
+  return gethash(static_slot_type_hash, slot);
+}
+
+val slot_type_reg(val slot, val strct)
+{
+  val typelist = gethash(slot_type_hash, slot);
+
+  if (!memq(strct, typelist)) {
+    sethash(slot_type_hash, slot, cons(strct, typelist));
+    uw_purge_deferred_warning(cons(slot_s, slot));
+  }
+
+  return slot;
+}
+
+val static_slot_type_reg(val slot, val strct)
+{
+  val typelist = gethash(static_slot_type_hash, slot);
+
+  if (!memq(strct, typelist)) {
+    sethash(slot_type_hash, slot, cons(strct, typelist));
+    uw_purge_deferred_warning(cons(static_slot_s, slot));
+    uw_purge_deferred_warning(cons(slot_s, slot));
+  }
+
+  return slot;
+}
+
 static_def(struct cobj_ops struct_type_ops =
            cobj_ops_init(eq, struct_type_print, struct_type_destroy,
                          struct_type_mark, cobj_hash_op))
diff --git a/struct.h b/struct.h
index 10f87f72..e558745f 100644
--- a/struct.h
+++ b/struct.h
@@ -25,7 +25,8 @@
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
-extern val struct_type_s, meth_s, make_struct_lit_s;
+extern val struct_type_s, meth_s, print_s, make_struct_lit_s;
+extern val slot_s, static_slot_s;
 val make_struct_type(val name, val super,
                      val static_slots, val slots,
                      val static_initfun, val initfun, val boactor,
@@ -64,4 +65,8 @@ val uslot(val slot);
 val umethod(val slot, struct args *);
 val method_name(val fun);
 val get_slot_syms(val package, val is_current, val method_only);
+val slot_types(val slot);
+val static_slot_types(val slot);
+val slot_type_reg(val slot, val strct);
+val static_slot_type_reg(val slot, val strct);
 void struct_init(void);