From b88755769b40efc9461ef28f7a0ed2d388d8ff33 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 24 Aug 2013 11:39:16 -0700
Subject: [PATCH] help.lint: add slot checking, don't check constants for
 $values.

---
 basis/help/lint/checks/checks.factor | 34 ++++++++++++++++++++--------
 basis/help/lint/lint.factor          |  1 +
 2 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor
index b7cb680e87..463b83f2c9 100644
--- a/basis/help/lint/checks/checks.factor
+++ b/basis/help/lint/checks/checks.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs classes combinators
-combinators.short-circuit definitions effects eval fry grouping
-help help.markup help.topics io.streams.string kernel macros
-namespaces sequences sequences.deep sets sorting splitting
-strings unicode.categories vocabs vocabs.loader words
-words.symbol summary debugger io ;
+USING: accessors arrays assocs classes classes.tuple combinators
+combinators.short-circuit debugger definitions effects eval fry
+grouping help help.markup help.topics io io.streams.string
+kernel macros namespaces sequences sequences.deep sets splitting
+strings summary unicode.categories vocabs vocabs.loader words
+words.constant words.symbol ;
 FROM: sets => members ;
 IN: help.lint.checks
 
@@ -74,6 +74,7 @@ SYMBOL: vocab-articles
         [ symbol? ]
         [ parsing-word? ]
         [ "declared-effect" word-prop not ]
+        [ constant? ]
     } 1|| ;
 
 : check-values ( word element -- )
@@ -86,7 +87,7 @@ SYMBOL: vocab-articles
             [ effect-values ]
             [ extract-values ]
             bi* sequence=
-        ] 
+        ]
     } 2|| [ "$values don't match stack effect" simple-lint-error ] unless ;
 
 : check-value-effects ( word element -- )
@@ -144,10 +145,23 @@ SYMBOL: vocab-articles
         simple-lint-error
     ] when ;
 
+: extract-slots ( elements -- seq )
+    [ dup pair? [ first \ $slot = ] [ drop f ] if ] deep-filter
+    [ second ] map ;
+
 : check-class-description ( word element -- )
-    [ class? not ]
-    [ { $class-description } swap elements empty? not ] bi* and
-    [ "A word that is not a class has a $class-description" simple-lint-error ] when ;
+    \ $class-description swap elements over class? [
+        [ all-slots [ name>> ] map ] [ extract-slots ] bi*
+        [ swap member? not ] with filter [
+            ", " join "Described $slot does not exist: " prepend
+            simple-lint-error
+        ] unless-empty
+    ] [
+        nip empty? not [
+            "A word that is not a class has a $class-description"
+            simple-lint-error
+        ] when
+    ] if ;
 
 : check-article-title ( article -- )
     article-title first LETTER?
diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor
index 7e8c2e8c94..3bf84c6703 100644
--- a/basis/help/lint/lint.factor
+++ b/basis/help/lint/lint.factor
@@ -53,6 +53,7 @@ PRIVATE>
                 [ check-values ]
                 [ check-value-effects ]
                 [ check-class-description ]
+                [ check-class-slots ]
                 [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ]
             } 2cleave
         ] check-something