From 4367b15c4a3825448ad53d6763de616ba1731655 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Tue, 9 Mar 2010 19:51:04 -0800
Subject: [PATCH] update help-lint to complain when $quotation effect doesn't
 match declared effect on corresponding input parameter of stack effect

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

diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor
index 632cdb46e2..85fa50f2b9 100644
--- 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 47b8820f18..7112eb5da9 100644
--- 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 ;