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.

1 files changed, 33 insertions, 8 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))))