From cb6bf83f2f7065515a5a70890626b113f3a804bc Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 11 Mar 2010 14:09:18 -0800
Subject: [PATCH] pre-chew the bite-sized morsels of
 stack-checker.row-polymorphism so they're easy for old people to digest

---
 .../row-polymorphism/row-polymorphism.factor  | 44 +++++++++----------
 1 file changed, 20 insertions(+), 24 deletions(-)

diff --git a/basis/stack-checker/row-polymorphism/row-polymorphism.factor b/basis/stack-checker/row-polymorphism/row-polymorphism.factor
index ef47dfe285..d91c766fea 100644
--- a/basis/stack-checker/row-polymorphism/row-polymorphism.factor
+++ b/basis/stack-checker/row-polymorphism/row-polymorphism.factor
@@ -24,45 +24,41 @@ IN: stack-checker.row-polymorphism
     meta-d length input-count get
     [ with-inner-d ] 2dip (effect-here) ; inline
 
-:: (check-variable) ( actual-count declared-count variable vars -- difference ? )
-    actual-count declared-count -
-    variable [
-        variable vars at* nip
-        [ variable vars at -     ]
-        [ variable vars set-at 0 ] if
-        t
-    ] [ dup 0 <= ] if ;
+: (diff-variable) ( diff variable vars -- diff' )
+    [ at* nip ] [ '[ _ _ at - ] ] [ '[ _ _ set-at 0 ] ] 2tri if ;
+
+: (check-variable) ( actual-count declared-count variable vars -- diff ? )
+    [ - ] 2dip dupd '[ _ _ (diff-variable) t ] [ dup 0 <= ] if ;
 
 : adjust-variable ( diff var vars -- )
-    pick 0 >=
-    [ at+ ]
-    [ 3drop ] if ; inline
+    pick 0 >= [ at+ ] [ 3drop ] if ; inline
 
 :: check-variable ( vars declared actual slot var-slot -- diff ok? var )
     actual declared [ slot call length ] bi@ declared var-slot call
     [ vars (check-variable) ] keep ; inline
 
 :: unify-variables ( in-diff in-ok? in-var out-diff out-ok? out-var vars -- ? )
-    { [ in-ok? ] [ out-ok? ] [ in-diff out-diff = ] } 0&&
-    dup [
+    { [ in-ok? ] [ out-ok? ] [ in-diff out-diff = ] } 0&& dup [
         in-var  [ in-diff  swap vars adjust-variable ] when*
         out-var [ out-diff swap vars adjust-variable ] when*
     ] when ;
 
+: (check-variables) ( vars declared actual -- ? )
+    [ [ in>>  ] [ in-var>>  ] check-variable ]
+    [ [ out>> ] [ out-var>> ] check-variable ]
+    [ 2drop ] 3tri unify-variables ;
+
 : check-variables ( vars declared actual -- ? )
-    dup terminated?>> [ 3drop t ] [
-        [ [ in>>  ] [ in-var>>  ] check-variable ]
-        [ [ out>> ] [ out-var>> ] check-variable ]
-        [ 2drop ] 3tri unify-variables
-    ] if ;
+    dup terminated?>> [ 3drop t ] [ (check-variables) ] if ;
+
+: combinator-branches-effects ( branches -- quots declareds actuals )
+    [ [ known>callable ] { } map-as ]
+    [ [ effect>> ] { } map-as ]
+    [ [ actual>> ] { } map-as ] tri ;
 
 : combinator-unbalanced-branches-error ( known -- * )
-    [ word>> ] [
-        branches>> <reversed>
-        [ [ known>callable ] { } map-as ]
-        [ [ effect>> ] { } map-as ]
-        [ [ actual>> ] { } map-as ] tri
-    ] bi unbalanced-branches-error ;
+    [ word>> ] [ branches>> <reversed> combinator-branches-effects ] bi
+    unbalanced-branches-error ;
 
 : check-declared-effect ( known effect -- )
     [ >>actual ] keep