stack-checker: a little cleanup.

basis/stack-checker/backend/backend.factor

@@ -11,7 +11,7 @@ IN: stack-checker.backend
 : push-d ( obj -- ) meta-d push ;
 
 : introduce-values ( values -- )
-    [ [ [ input-parameter ] dip set-known ] each ]
+    [ [ input-parameter swap set-known ] each ]
     [ length input-count +@ ]
     [ #introduce, ]
     tri ;
@@ -55,12 +55,10 @@ IN: stack-checker.backend
 : push-r ( obj -- ) meta-r push ;
 
 : pop-r ( -- obj )
-    meta-r dup empty?
+    meta-r [ too-many-r> ] [ pop ] if-empty ;
-    [ too-many-r> ] [ pop ] if ;
 
 : consume-r ( n -- seq )
-    meta-r 2dup length >
+    meta-r 2dup length > [ too-many-r> ] when
-    [ too-many-r> ] when
     [ swap tail* ] [ shorten-by ] 2bi ;
 
 : output-r ( seq -- ) meta-r push-all ;
@@ -76,8 +74,11 @@ IN: stack-checker.backend
     ] [ pop recursive-state get swap ] if-empty ;
 
 : literals-available? ( n -- literals ? )
-    literals get 2dup length <=
+    literals get 2dup length <= [
-    [ [ swap tail* ] [ shorten-by ] 2bi t ] [ 2drop f f ] if ;
+        [ swap tail* ] [ shorten-by ] 2bi t
+    ] [
+        2drop f f
+    ] if ;
 
 GENERIC: apply-object ( obj -- )
 

basis/stack-checker/dependencies/dependencies.factor

@@ -75,7 +75,7 @@ GENERIC: satisfied? ( dependency -- ? )
 TUPLE: depends-on-class-predicate class1 class2 result ;
 
 : add-depends-on-class-predicate ( class1 class2 result -- )
-    \ depends-on-class-predicate add-conditional-dependency ;
+    depends-on-class-predicate add-conditional-dependency ;
 
 M: depends-on-class-predicate satisfied?
     {
@@ -87,7 +87,7 @@ M: depends-on-class-predicate satisfied?
 TUPLE: depends-on-instance-predicate object class result ;
 
 : add-depends-on-instance-predicate ( object class result -- )
-    \ depends-on-instance-predicate add-conditional-dependency ;
+    depends-on-instance-predicate add-conditional-dependency ;
 
 M: depends-on-instance-predicate satisfied?
     {
@@ -99,7 +99,7 @@ TUPLE: depends-on-next-method class generic next-method ;
 
 : add-depends-on-next-method ( class generic next-method -- )
     over add-depends-on-conditionally
-    \ depends-on-next-method add-conditional-dependency ;
+    depends-on-next-method add-conditional-dependency ;
 
 M: depends-on-next-method satisfied?
     {
@@ -111,7 +111,7 @@ TUPLE: depends-on-method class generic method ;
 
 : add-depends-on-method ( class generic method -- )
     over add-depends-on-conditionally
-    \ depends-on-method add-conditional-dependency ;
+    depends-on-method add-conditional-dependency ;
 
 M: depends-on-method satisfied?
     {
@@ -123,7 +123,7 @@ TUPLE: depends-on-tuple-layout class layout ;
 
 : add-depends-on-tuple-layout ( class layout -- )
     [ drop add-depends-on-conditionally ]
-    [ \ depends-on-tuple-layout add-conditional-dependency ] 2bi ;
+    [ depends-on-tuple-layout add-conditional-dependency ] 2bi ;
 
 M: depends-on-tuple-layout satisfied?
     [ class>> tuple-layout ] [ layout>> ] bi eq? ;
@@ -132,7 +132,7 @@ TUPLE: depends-on-flushable word ;
 
 : add-depends-on-flushable ( word -- )
     [ add-depends-on-conditionally ]
-    [ \ depends-on-flushable add-conditional-dependency ] bi ;
+    [ depends-on-flushable add-conditional-dependency ] bi ;
 
 M: depends-on-flushable satisfied?
     word>> flushable? ;
@@ -141,7 +141,7 @@ TUPLE: depends-on-final class ;
 
 : add-depends-on-final ( word -- )
     [ add-depends-on-conditionally ]
-    [ \ depends-on-final add-conditional-dependency ] bi ;
+    [ depends-on-final add-conditional-dependency ] bi ;
 
 M: depends-on-final satisfied?
     class>> { [ class? ] [ final-class? ] } 1&& ;

basis/stack-checker/inlining/inlining.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays effects fry hints kernel math math.order
+USING: accessors arrays effects fry hints kernel locals math
-namespaces sequences stack-checker.backend
+math.order namespaces sequences stack-checker.backend
 stack-checker.dependencies stack-checker.errors
 stack-checker.known-words stack-checker.recursive-state
 stack-checker.state stack-checker.values stack-checker.visitor
@@ -56,17 +56,15 @@ SYMBOL: enter-out
 : entry-stack-height ( label -- stack )
     enter-out>> length ;
 
-: check-return ( word label -- )
+:: check-return ( word label -- )
-    2dup
+    word stack-height
-    [ stack-height ]
+    current-stack-height label entry-stack-height -
-    [ entry-stack-height current-stack-height swap - ]
+    = [
-    bi*
+        terminated? get [
-    = [ 2drop ] [
+            label word>> current-stack-height
-        terminated? get [ 2drop ] [
-            word>> current-stack-height
             unbalanced-recursion-error inference-error
-        ] if
+        ] unless
-    ] if ;
+    ] unless ;
 
 : end-recursive-word ( word label -- )
     [ check-return ]
@@ -134,10 +132,12 @@ M: declared-effect (undeclared-known) known>> (undeclared-known) ;
     <effect> ;
 
 : call-recursive-inline-word ( word label -- )
-    over "recursive" word-prop [
+    over recursive? [
         [ required-stack-effect adjust-stack-effect ] dip
         [ check-call ] [ '[ _ #call-recursive, ] consume/produce ] bi
-    ] [ drop undeclared-recursion-error inference-error ] if ;
+    ] [
+        drop undeclared-recursion-error inference-error
+    ] if ;
 
 : inline-word ( word -- )
     commit-literals
@@ -147,7 +147,7 @@ M: declared-effect (undeclared-known) known>> (undeclared-known) ;
         dup inline-recursive-label [
             call-recursive-inline-word
         ] [
-            dup "recursive" word-prop
+            dup recursive?
             [ inline-recursive-word ]
             [ dup infer-inline-word-def ]
             if

basis/stack-checker/values/values.factor

@@ -45,7 +45,7 @@ TUPLE: literal-tuple < identity-tuple value recursion ;
 M: literal-tuple hashcode* nip value>> identity-hashcode ;
 
 : <literal> ( obj -- value )
-    recursive-state get \ literal-tuple boa ;
+    recursive-state get literal-tuple boa ;
 
 M: literal-tuple (input-value?) drop f ;
 
@@ -56,7 +56,7 @@ M: literal-tuple (literal) ;
 : curried/composed-literal ( input1 input2 quot -- literal )
     [ [ literal ] bi@ ] dip
     [ [ [ value>> ] bi@ ] dip call ] [ drop nip recursion>> ] 3bi
-    \ literal-tuple boa ; inline
+    literal-tuple boa ; inline
 
 TUPLE: curried obj quot ;
 
@@ -82,7 +82,7 @@ C: <composed> composed
     [ quot1>> ] [ quot2>> ] bi ; inline
 
 M: composed (input-value?)
-    [ quot1>> input-value? ] [ quot2>> input-value? ] bi or ;
+    >composed< [ input-value? ] either? ;
 
 M: composed (literal-value?)
     >composed< [ literal-value? ] both? ;
@@ -132,12 +132,10 @@ M: object known>callable drop \ _ ;
 M: literal-tuple known>callable value>> ;
 
 M: composed known>callable
-    [ quot1>> ] [ quot2>> ] bi
+    >composed< [ known known>callable ?@ ] bi@ append ;
-    [ known known>callable ?@ ] bi@ append ;
 
 M: curried known>callable
-    [ quot>> ] [ obj>> ] bi
+    >curried< [ known known>callable ] bi@ swap prefix ;
-    [ known known>callable ] bi@ prefix ;
 
 M: declared-effect known>callable
     known>> known>callable ;