Merge branch 'bags' of git://github.com/littledan/Factor

[factor.git] / basis / help / lint / checks / checks.factor

diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor
index 47e171422981bc62e3cf74f57c36ab9ddc5cf6ec..87b44595d27e9d10db7108a13153754f158ae2d2 100644 (file)
--- a/basis/help/lint/checks/checks.factor
+++ b/basis/help/lint/checks/checks.factor
@@ -37,11 +37,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 members ;
 
+: 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
@@ -71,9 +87,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?