update help-lint to complain when $quotation effect doesn't match declared effect...

diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor
index 632cdb46e258adb113b098572a161b03fee0a366..85fa50f2b9638474a5b9ac21224d154344a5e9af 100644 (file)
--- a/basis/help/lint/checks/checks.factor
+++ b/basis/help/lint/checks/checks.factor
@@ -36,11 +36,27 @@ SYMBOL: vocab-articles
         first rest [ first ] map
     ] unless ;
 
+: extract-value-effects ( element -- seq )
+    \ $values swap elements dup empty? [
+        first rest [ 
+            \ $quotation swap elements dup empty? [ drop f ] [
+                first second
+            ] if
+        ] map
+    ] unless ;
+
 : effect-values ( word -- seq )
     stack-effect
     [ in>> ] [ out>> ] bi append
     [ dup pair? [ first ] when effect>string ] map prune ;
 
+: effect-effects ( word -- seq )
+    stack-effect in>> [
+        dup pair?
+        [ second dup effect? [ effect>string ] [ drop f ] if ]
+        [ drop f ] if
+    ] map ;
+
 : contains-funky-elements? ( element -- ? )
     {
         $shuffle
@@ -70,9 +86,16 @@ 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 -- )
+    [ effect-effects ]
+    [ extract-value-effects ]
+    bi* [ 2dup and [ = ] [ 2drop t ] if ] 2all?
+    [ "$quotation documentation in $values don't match stack effect" simple-lint-error ]
+    unless ;
+
 : check-nulls ( element -- )
     \ $values swap elements
     null swap deep-member?

diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor
index 47b8820f18d87b4466e66ac2fbc71c44edb1015e..7112eb5da97443e8d42bcf65b8eba47a27984396 100644 (file)
--- a/basis/help/lint/lint.factor
+++ b/basis/help/lint/lint.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs continuations fry help help.lint.checks
-help.topics io kernel namespaces parser sequences
-source-files.errors vocabs.hierarchy vocabs words classes
-locals tools.errors listener ;
+USING: assocs combinators continuations fry help
+help.lint.checks help.topics io kernel namespaces parser
+sequences source-files.errors vocabs.hierarchy vocabs words
+classes locals tools.errors listener ;
 FROM: help.lint.checks => all-vocabs ;
 FROM: vocabs => child-vocabs ;
 IN: help.lint
@@ -49,10 +49,12 @@ PRIVATE>
     [ with-file-vocabs ] vocabs-quot set
     dup word-help [
         [ >link ] keep '[
-            _ dup word-help
-            [ check-values ]
-            [ check-class-description ]
-            [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ] 2tri
+            _ dup word-help {
+                [ check-values ]
+                [ check-value-effects ]
+                [ check-class-description ]
+                [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ]
+            } 2cleave
         ] check-something
     ] [ drop ] if ;