Adding inline recursive declarations

core/assocs/assocs.factor

@@ -84,7 +84,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
     ] [
         3dup nth-unsafe at*
         [ >r 3drop r> ] [ drop >r 1- r> (assoc-stack) ] if
-    ] if ; inline
+    ] if ; inline recursive
 
 : assoc-stack ( key seq -- value )
     dup length 1- swap (assoc-stack) ;

core/binary-search/binary-search.factor

@@ -16,7 +16,7 @@ IN: binary-search
     [ [ from>> ] [ midpoint@ ] bi + ] [ seq>> ] bi
     [ drop ] [ dup ] [ ] tri* nth ; inline
 
-: (search) ( quot seq -- i elt )
+: (search) ( quot: ( elt -- <=> ) seq -- i elt )
     dup length 1 <= [
         finish
     ] [
@@ -25,7 +25,7 @@ IN: binary-search
             { +lt+ [ dup midpoint@ head-slice (search) ] }
             { +gt+ [ dup midpoint@ tail-slice (search) ] }
         } case
-    ] if ; inline
+    ] if ; inline recursive
 
 PRIVATE>
 

core/bootstrap/syntax.factor

@@ -59,6 +59,7 @@ IN: bootstrap.syntax
     "flushable"
     "foldable"
     "inline"
+    "recursive"
     "parsing"
     "t"
     "{"

core/combinators/combinators.factor

@@ -90,10 +90,10 @@ ERROR: no-case ;
 : <buckets> ( initial length -- array )
     next-power-of-2 swap [ nip clone ] curry map ;
 
-: distribute-buckets ( assoc initial quot -- buckets )
+: distribute-buckets ( alist initial quot -- buckets )
-    spin [ length <buckets> ] keep
+    swapd [ >r dup first r> call 2array ] curry map
-    [ >r 2dup r> dup first roll call (distribute-buckets) ] each
+    [ length <buckets> dup ] keep
-    nip ; inline
+    [ first2 (distribute-buckets) ] with each ; inline
 
 : hash-case-table ( default assoc -- array )
     V{ } [ 1array ] distribute-buckets

core/dequeues/dequeues.factor

@@ -37,8 +37,7 @@ GENERIC: node-value ( node -- value )
     [ peek-back ] [ pop-back* ] bi ;
 
 : slurp-dequeue ( dequeue quot -- )
-    over dequeue-empty? [ 2drop ] [
+    [ drop [ dequeue-empty? not ] curry ]
-        [ [ pop-back ] dip call ] [ slurp-dequeue ] 2bi
+    [ [ pop-back ] prepose curry ] 2bi [ ] while ; inline
-    ] if ; inline
 
 MIXIN: dequeue

core/dlists/dlists.factor

@@ -48,11 +48,11 @@ M: dlist-node node-value obj>> ;
 : set-front-to-back ( dlist -- )
     dup front>> [ dup back>> >>front ] unless drop ;
 
-: (dlist-find-node) ( dlist-node quot -- node/f ? )
+: (dlist-find-node) ( dlist-node quot: ( node -- ? ) -- node/f ? )
     over [
         [ call ] 2keep rot
         [ drop t ] [ >r next>> r> (dlist-find-node) ] if
-    ] [ 2drop f f ] if ; inline
+    ] [ 2drop f f ] if ; inline recursive
 
 : dlist-find-node ( dlist quot -- node/f ? )
     >r front>> r> (dlist-find-node) ; inline

core/effects/effects.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math namespaces sequences strings words assocs
-combinators accessors ;
+combinators accessors arrays ;
 IN: effects
 
 TUPLE: effect in out terminated? ;
@@ -22,15 +22,16 @@ TUPLE: effect in out terminated? ;
         [ t ]
     } cond 2nip ;
 
-GENERIC: (stack-picture) ( obj -- str )
+GENERIC: effect>string ( obj -- str )
-M: string (stack-picture) ;
+M: string effect>string ;
-M: word (stack-picture) name>> ;
+M: word effect>string name>> ;
-M: integer (stack-picture) drop "object" ;
+M: integer effect>string drop "object" ;
+M: pair effect>string first2 [ effect>string ] bi@ ": " swap 3append ;
 
 : stack-picture ( seq -- string )
-    [ [ (stack-picture) % CHAR: \s , ] each ] "" make ;
+    [ [ effect>string % CHAR: \s , ] each ] "" make ;
 
-: effect>string ( effect -- string )
+M: effect effect>string ( effect -- string )
     [
         "( " %
         [ in>> stack-picture % "-- " % ]
@@ -51,6 +52,9 @@ M: word stack-effect
 M: effect clone
     [ in>> clone ] [ out>> clone ] bi <effect> ;
 
+: stack-height ( word -- n )
+    stack-effect effect-height ;
+
 : split-shuffle ( stack shuffle -- stack1 stack2 )
     in>> length cut* ;
 

core/effects/parser/parser.factor

@@ -1,15 +1,31 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: lexer sets sequences kernel splitting effects ;
+USING: lexer sets sequences kernel splitting effects summary
+combinators debugger arrays parser ;
 IN: effects.parser
 
-: parse-effect ( end -- effect )
+DEFER: parse-effect
-    parse-tokens dup { "(" "((" } intersect empty? [
+
-        { "--" } split1 dup [
+ERROR: bad-effect ;
-            <effect>
+
-        ] [
+M: bad-effect summary
-            "Stack effect declaration must contain --" throw
+    drop "Bad stack effect declaration" ;
+
+: parse-effect-token ( end -- token/f )
+    scan tuck = [ drop f ] [
+        dup { f "(" "((" } member? [ bad-effect ] [
+            ":" ?tail [
+                scan-word {
+                    { \ ( [ ")" parse-effect ] }
+                    [ ]
+                } case 2array
+            ] when
         ] if
-    ] [
-        "Stack effect declaration must not contain ( or ((" throw
     ] if ;
+
+: parse-effect-tokens ( end -- tokens )
+    [ parse-effect-token dup ] curry [ ] [ drop ] produce ;
+
+: parse-effect ( end -- effect )
+    parse-effect-tokens { "--" } split1 dup
+    [ <effect> ] [ "Stack effect declaration must contain --" throw ] if ;

core/generic/generic.factor

@@ -77,6 +77,9 @@ TUPLE: check-method class generic ;
 PREDICATE: method-body < word
     "method-generic" word-prop >boolean ;
 
+M: method-body inline?
+    "method-generic" word-prop inline? ;
+
 M: method-body stack-effect
     "method-generic" word-prop stack-effect ;
 

core/generic/standard/engines/tuple/tuple.factor

@@ -64,6 +64,9 @@ M: engine-word stack-effect
     [ extra-values ] [ stack-effect ] bi
     dup [ clone [ length + ] change-in ] [ 2drop f ] if ;
 
+M: engine-word inline?
+    "tuple-dispatch-generic" word-prop inline? ;
+
 M: engine-word crossref? "forgotten" word-prop not ;
 
 M: engine-word irrelevant? drop t ;

core/graphs/graphs.factor

@@ -37,14 +37,14 @@ SYMBOL: graph
 
 SYMBOL: previous
 
-: (closure) ( obj quot -- )
+: (closure) ( obj quot: ( elt -- assoc ) -- )
     over previous get key? [
         2drop
     ] [
         over previous get conjoin
         dup slip
         [ nip (closure) ] curry assoc-each
-    ] if ; inline
+    ] if ; inline recursive
 
 : closure ( obj quot -- assoc )
     H{ } clone [

core/hashtables/hashtables.factor

@@ -27,7 +27,7 @@ TUPLE: hashtable
     dup ((empty)) eq?
     [ 3drop no-key ] [
         = [ rot drop t ] [ probe (key@) ] if
-    ] if ; inline
+    ] if ; inline recursive
 
 : key@ ( key hash -- array n ? )
     array>> dup length>> 0 eq?
@@ -51,7 +51,7 @@ TUPLE: hashtable
         ] [
             probe (new-key@)
         ] if
-    ] if ; inline
+    ] if ; inline recursive
 
 : new-key@ ( key hash -- array n empty? )
     array>> 2dup hash@ (new-key@) ; inline

core/inference/backend/backend.factor

@@ -365,7 +365,8 @@ TUPLE: unbalanced-branches-error quots in out ;
     [ unify-effects ] [ unify-dataflow ] bi ; inline
 
 : infer-branches ( last branches node -- )
-    #! last is a quotation which provides a #return or a #values
+    #! last -> #return or #values
+    #! node -> #if or #dispatch
     1 reify-curries
     call dup node,
     pop-d drop

core/inference/class/class-tests.factor

@@ -620,6 +620,8 @@ TUPLE: declared-fixnum { x fixnum } ;
     [ { ascii } declare decode-char ] \ decode-char inlined?
 ] unit-test
 
+[ t ] [ [ { 1 2 } length ] { length length>> slot } inlined? ] unit-test
+
 ! Later
 
 ! [ t ] [

core/inference/dataflow/dataflow.factor

@@ -144,7 +144,8 @@ TUPLE: #dispatch < #branch ;
 
 : #dispatch ( -- node ) peek-d 1array \ #dispatch in-node ;
 
-TUPLE: #merge < node ;
+! Phi node: merging is a sequence of sequences of values
+TUPLE: #merge < node merging ;
 
 : #merge ( -- node ) \ #merge all-out-node ;
 
@@ -191,7 +192,7 @@ TUPLE: #declare < node ;
 : #drop ( n -- #shuffle )
     d-tail flatten-curries \ #shuffle in-node ;
 
-: node-exists? ( node quot -- ? )
+: node-exists? ( node quot: ( node -- ? ) -- ? )
     over [
         2dup 2slip rot [
             2drop t
@@ -201,7 +202,7 @@ TUPLE: #declare < node ;
         ] if
     ] [
         2drop f
-    ] if ; inline
+    ] if ; inline recursive
 
 GENERIC: calls-label* ( label node -- ? )
 
@@ -223,21 +224,21 @@ SYMBOL: node-stack
 
 : iterate-next ( -- node ) node@ successor>> ;
 
-: iterate-nodes ( node quot -- )
+: iterate-nodes ( node quot: ( -- ) -- )
     over [
         [ swap >node call node> drop ] keep iterate-nodes
     ] [
         2drop
-    ] if ; inline
+    ] if ; inline recursive
 
-: (each-node) ( quot -- next )
+: (each-node) ( quot: ( node -- ) -- next )
     node@ [ swap call ] 2keep
     node-children [
         [
             [ (each-node) ] keep swap
         ] iterate-nodes
     ] each drop
-    iterate-next ; inline
+    iterate-next ; inline recursive
 
 : with-node-iterator ( quot -- )
     >r V{ } clone node-stack r> with-variable ; inline
@@ -260,14 +261,14 @@ SYMBOL: node-stack
         2drop
     ] if ; inline
 
-: (transform-nodes) ( prev node quot -- )
+: (transform-nodes) ( prev node quot: ( node -- newnode ) -- )
     dup >r call dup [
         >>successor
         successor>> dup successor>>
         r> (transform-nodes)
     ] [
         r> 2drop f >>successor drop
-    ] if ; inline
+    ] if ; inline recursive
 
 : transform-nodes ( node quot -- new-node )
     over [

core/inference/transforms/transforms.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel words sequences generic math
-namespaces quotations assocs combinators math.bitfields
+namespaces quotations assocs combinators
 inference.backend inference.dataflow inference.state
 classes.tuple classes.tuple.private effects summary hashtables
 classes generic sets definitions generic.standard slots.private ;
@@ -48,25 +48,6 @@ IN: inference.transforms
 
 \ spread [ spread>quot ] 1 define-transform
 
-! Bitfields
-GENERIC: (bitfield-quot) ( spec -- quot )
-
-M: integer (bitfield-quot) ( spec -- quot )
-    [ swapd shift bitor ] curry ;
-
-M: pair (bitfield-quot) ( spec -- quot )
-    first2 over word? [ >r swapd execute r> ] [ ] ?
-    [ shift bitor ] append 2curry ;
-
-: bitfield-quot ( spec -- quot )
-    [ (bitfield-quot) ] map [ 0 ] prefix concat ;
-
-\ bitfield [ bitfield-quot ] 1 define-transform
-
-\ flags [
-    [ 0 , [ , \ bitor , ] each ] [ ] make
-] 1 define-transform
-
 ! Tuple operations
 : [get-slots] ( slots -- quot )
     [ [ 1quotation , \ keep , ] each \ drop , ] [ ] make ;

core/io/encodings/encodings.factor

@@ -93,11 +93,10 @@ M: decoder stream-read-partial stream-read ;
         { CHAR: \n [ line-ends\n ] }
     } case ; inline
 
-: ((read-until)) ( buf quot -- string/f sep/f )
+: ((read-until)) ( buf quot: ( -- char stop? ) -- string/f sep/f )
-    ! quot: -- char stop?
     dup call
     [ >r drop "" like r> ]
-    [ pick push ((read-until)) ] if ; inline
+    [ pick push ((read-until)) ] if ; inline recursive
 
 : (read-until) ( quot -- string/f sep/f )
     100 <sbuf> swap ((read-until)) ; inline

core/kernel/kernel.factor

@@ -109,10 +109,13 @@ DEFER: if
 : 2bi@ ( w x y z quot -- )
     dup 2bi* ; inline
 
-: while ( pred body tail -- )
+: loop ( pred: ( -- ? ) -- )
+    dup slip swap [ loop ] [ drop ] if ; inline recursive
+
+: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
     >r >r dup slip r> r> roll
     [ >r tuck 2slip r> while ]
-    [ 2nip call ] if ; inline
+    [ 2nip call ] if ; inline recursive
 
 ! Object protocol
 GENERIC: hashcode* ( depth obj -- code )

core/listener/listener.factor

@@ -59,9 +59,7 @@ SYMBOL: error-hook
     ] recover ;
 
 : until-quit ( -- )
-    quit-flag get
+    quit-flag get [ quit-flag off ] [ listen until-quit ] if ;
-    [ quit-flag off ]
-    [ listen until-quit ] if ; inline
 
 : listener ( -- )
     [ until-quit ] with-interactive-vocabs ;

core/math/bitfields/bitfields-tests.factor

@@ -15,3 +15,13 @@ IN: math.bitfields.tests
 [ 3 ] [ foo ] unit-test
 [ 3 ] [ { a b } flags ] unit-test
 \ foo must-infer
+
+[ 0 ] [ { } bitfield-quot call ] unit-test
+
+[ 256 ] [ 1 { 8 } bitfield-quot call ] unit-test
+
+[ 268 ] [ 3 1 { 8 2 } bitfield-quot call ] unit-test
+
+[ 268 ] [ 1 { 8 { 3 2 } } bitfield-quot call ] unit-test
+
+[ 512 ] [ 1 { { 1+ 8 } } bitfield-quot call ] unit-test

core/math/bitfields/bitfields.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math sequences words ;
+USING: arrays kernel math sequences words
+namespaces inference.transforms ;
 IN: math.bitfields
 
 GENERIC: (bitfield) ( value accum shift -- newaccum )
@@ -16,3 +17,21 @@ M: pair (bitfield) ( value accum pair -- newaccum )
 
 : flags ( values -- n )
     0 [ dup word? [ execute ] when bitor ] reduce ;
+
+GENERIC: (bitfield-quot) ( spec -- quot )
+
+M: integer (bitfield-quot) ( spec -- quot )
+    [ swapd shift bitor ] curry ;
+
+M: pair (bitfield-quot) ( spec -- quot )
+    first2 over word? [ >r swapd execute r> ] [ ] ?
+    [ shift bitor ] append 2curry ;
+
+: bitfield-quot ( spec -- quot )
+    [ (bitfield-quot) ] map [ 0 ] prefix concat ;
+
+\ bitfield [ bitfield-quot ] 1 define-transform
+
+\ flags [
+    [ 0 , [ , \ bitor , ] each ] [ ] make
+] 1 define-transform

core/math/integers/integers.factor

@@ -40,7 +40,7 @@ M: fixnum bit? neg shift 1 bitand 0 > ;
 
 : (fixnum-log2) ( accum n -- accum )
     dup 1 number= [ drop ] [ >r 1+ r> 2/ (fixnum-log2) ] if ;
-    inline
+    inline recursive
 
 M: fixnum (log2) 0 swap (fixnum-log2) ;
 

core/math/math.factor

@@ -124,21 +124,21 @@ M: float fp-nan?
 
 PRIVATE>
 
-: (each-integer) ( i n quot -- )
+: (each-integer) ( i n quot: ( i -- ) -- )
     [ iterate-step iterate-next (each-integer) ]
-    [ 3drop ] if-iterate? ; inline
+    [ 3drop ] if-iterate? ; inline recursive
 
-: (find-integer) ( i n quot -- i )
+: (find-integer) ( i n quot: ( i -- ? ) -- i )
     [
         iterate-step roll
         [ 2drop ] [ iterate-next (find-integer) ] if
-    ] [ 3drop f ] if-iterate? ; inline
+    ] [ 3drop f ] if-iterate? ; inline recursive
 
-: (all-integers?) ( i n quot -- ? )
+: (all-integers?) ( i n quot: ( i -- ? ) -- ? )
     [
         iterate-step roll
         [ iterate-next (all-integers?) ] [ 3drop f ] if
-    ] [ 3drop t ] if-iterate? ; inline
+    ] [ 3drop t ] if-iterate? ; inline recursive
 
 : each-integer ( n quot -- )
     iterate-prep (each-integer) ; inline
@@ -152,7 +152,7 @@ PRIVATE>
 : all-integers? ( n quot -- ? )
     iterate-prep (all-integers?) ; inline
 
-: find-last-integer ( n quot -- i )
+: find-last-integer ( n quot: ( i -- ? ) -- i )
     over 0 < [
         2drop f
     ] [
@@ -161,4 +161,4 @@ PRIVATE>
         ] [
             >r 1- r> find-last-integer
         ] if
-    ] if ; inline
+    ] if ; inline recursive

core/memory/memory.factor

@@ -5,9 +5,8 @@ USING: arrays kernel sequences vectors system hashtables
 kernel.private sbufs growable assocs namespaces quotations
 math strings combinators ;
 
-: (each-object) ( quot -- )
+: (each-object) ( quot: ( obj -- ) -- )
-    next-object dup
+    [ next-object dup ] swap [ drop ] while ; inline
-    [ swap [ call ] keep (each-object) ] [ 2drop ] if ; inline
 
 : each-object ( quot -- )
     begin-scan (each-object) end-scan ; inline

core/optimizer/control/control.factor

@@ -70,8 +70,6 @@ M: #label collect-label-info*
     [ V{ } clone node-stack get length 3array ] keep
     node-param label-info get set-at ;
 
-USE: prettyprint
-
 M: #call-label collect-label-info*
     node-param label-info get at
     node-stack get over third tail

core/sequences/sequences.factor

@@ -238,7 +238,8 @@ INSTANCE: repetition immutable-sequence
     ] 3keep ; inline
 
 : (copy) ( dst i src j n -- dst )
-    dup 0 <= [ 2drop 2drop ] [ 1- ((copy)) (copy) ] if ; inline
+    dup 0 <= [ 2drop 2drop ] [ 1- ((copy)) (copy) ] if ;
+    inline recursive
 
 : prepare-subseq ( from to seq -- dst i src j n )
     [ >r swap - r> new-sequence dup 0 ] 3keep
@@ -650,7 +651,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
 : halves ( seq -- first second )
     dup midpoint@ cut-slice ;
 
-: binary-reduce ( seq start quot -- value )
+: binary-reduce ( seq start quot: ( elt1 elt2 -- newelt ) -- value )
     #! We can't use case here since combinators depends on
     #! sequences
     pick length dup 0 3 between? [
@@ -665,7 +666,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
         >r >r halves r> r>
         [ [ binary-reduce ] 2curry bi@ ] keep
         call
-    ] if ; inline
+    ] if ; inline recursive
 
 : cut ( seq n -- before after )
     [ head ] [ tail ] 2bi ;

core/sorting/sorting.factor

@@ -52,14 +52,14 @@ TUPLE: merge
 : r-next  [ [ r-elt ] [ [ 1+ ] change-from2 drop ] bi ] [ accum>> ] bi push ; inline
 : decide  [ [ l-elt ] [ r-elt ] bi ] dip call +gt+ eq? ; inline
 
-: (merge) ( merge quot -- )
+: (merge) ( merge quot: ( elt1 elt2 -- <=> ) -- )
     over r-done? [ drop dump-l ] [
         over l-done? [ drop dump-r ] [
             2dup decide
             [ over r-next ] [ over l-next ] if
             (merge)
         ] if
-    ] if ; inline
+    ] if ; inline recursive
 
 : flip-accum ( merge -- )
     dup [ accum>> ] [ accum1>> ] bi eq? [
@@ -111,10 +111,9 @@ TUPLE: merge
     [ merge ] 2curry each-chunk ; inline
 
 : sort-loop ( merge quot -- )
-    2 swap
+    [ 2 [ over seq>> length over > ] ] dip
-    [ pick seq>> length pick > ]
+    [ [ 1 shift 2dup ] dip sort-pass ] curry
-    [ [ dup ] [ 1 shift ] [ ] tri* [ sort-pass ] 2keep ]
+    [ ] while 2drop ; inline
-    [ ] while 3drop ; inline
 
 : each-pair ( seq quot -- )
     [ [ length 1+ 2/ ] keep ] dip

core/splitting/splitting.factor

@@ -30,7 +30,7 @@ IN: splitting
 : (split) ( separators n seq -- )
     3dup rot [ member? ] curry find-from drop
     [ [ swap subseq , ] 2keep 1+ swap (split) ]
-    [ swap dup zero? [ drop ] [ tail ] if , drop ] if* ; inline
+    [ swap dup zero? [ drop ] [ tail ] if , drop ] if* ; inline recursive
 
 : split, ( seq separators -- ) 0 rot (split) ;
 

core/syntax/syntax.factor

@@ -89,6 +89,7 @@ IN: bootstrap.syntax
     "POSTPONE:" [ scan-word parsed ] define-syntax
     "\\" [ scan-word literalize parsed ] define-syntax
     "inline" [ word make-inline ] define-syntax
+    "recursive" [ word make-recursive ] define-syntax
     "foldable" [ word make-foldable ] define-syntax
     "flushable" [ word make-flushable ] define-syntax
     "delimiter" [ word t "delimiter" set-word-prop ] define-syntax

core/threads/threads.factor

@@ -195,7 +195,7 @@ M: real sleep
     <thread> [ (spawn) ] keep ;
 
 : spawn-server ( quot name -- thread )
-    >r [ [ ] [ ] while ] curry r> spawn ;
+    >r [ loop ] curry r> spawn ;
 
 : in-thread ( quot -- )
     >r datastack r>

core/words/words.factor

@@ -164,6 +164,9 @@ M: object redefined drop ;
 : make-inline ( word -- )
     t "inline" set-word-prop ;
 
+: make-recursive ( word -- )
+    t "recursive" set-word-prop ;
+
 : make-flushable ( word -- )
     t "flushable" set-word-prop ;
 
@@ -181,7 +184,7 @@ GENERIC: reset-word ( word -- )
 M: word reset-word
     {
         "unannotated-def"
-        "parsing" "inline" "foldable" "flushable"
+        "parsing" "inline" "recursive" "foldable" "flushable"
         "predicating"
         "reading" "writing"
         "constructing"
@@ -222,6 +225,10 @@ ERROR: bad-create name vocab ;
 : constructor-word ( name vocab -- word )
     >r "<" swap ">" 3append r> create ;
 
+GENERIC: inline? ( word -- ? )
+
+M: word inline? "inline" word-prop ;
+
 PREDICATE: parsing-word < word "parsing" word-prop ;
 
 : delimiter? ( obj -- ? )

extra/cocoa/enumeration/enumeration.factor

@@ -11,13 +11,13 @@ IN: cocoa.enumeration
         ] with-malloc
     ] with-malloc ; inline
 
-:: (NSFastEnumeration-each) ( object quot state stackbuf count -- )
+:: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- )
     object state stackbuf count -> countByEnumeratingWithState:objects:count:
     dup zero? [ drop ] [
         state NSFastEnumerationState-itemsPtr [ stackbuf ] unless*
         '[ , void*-nth quot call ] each
         object quot state stackbuf count (NSFastEnumeration-each)
-    ] if ; inline
+    ] if ; inline recursive
 
 : NSFastEnumeration-each ( object quot -- )
     [ (NSFastEnumeration-each) ] (with-enumeration-buffers) ; inline

extra/concurrency/mailboxes/mailboxes.factor

@@ -23,13 +23,13 @@ M: mailbox dispose* threads>> notify-all ;
 : wait-for-mailbox ( mailbox timeout -- )
     >r threads>> r> "mailbox" wait ;
 
-: block-unless-pred ( mailbox timeout pred -- )
+: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
     pick check-disposed
     pick data>> over dlist-contains? [
         3drop
     ] [
         >r 2dup wait-for-mailbox r> block-unless-pred
-    ] if ; inline
+    ] if ; inline recursive
 
 : block-if-empty ( mailbox timeout -- mailbox )
     over check-disposed
@@ -58,11 +58,7 @@ M: mailbox dispose* threads>> notify-all ;
     f mailbox-get-all-timeout ;
 
 : while-mailbox-empty ( mailbox quot -- )
-    over mailbox-empty? [
+    [ [ mailbox-empty? ] curry ] dip [ ] while ; inline
-        dup >r dip r> while-mailbox-empty
-    ] [
-        2drop
-    ] if ; inline
 
 : mailbox-get-timeout? ( mailbox timeout pred -- obj )
     3dup block-unless-pred

extra/concurrency/messaging/messaging-tests.factor

@@ -47,7 +47,7 @@ SYMBOL: exit
     } match-cond ;
 
 [ -5 ] [
-    [ 0 [ counter ] [ ] [ ] while ] "Counter" spawn "counter" set
+    [ 0 [ counter ] loop ] "Counter" spawn "counter" set
     { increment 10 } "counter" get send
     { decrement 15 } "counter" get send
     [ value , self , ] { } make "counter" get send

extra/io/monitors/monitors-tests.factor

@@ -55,7 +55,7 @@ os { winnt linux macosx } member? [
                     dup print flush
                     dup parent-directory
                     [ right-trim-separators "xyz" tail? ] either? not
-                ] [ ] [ ] while
+                ] loop
 
                 "c1" get count-down
                 
@@ -64,7 +64,7 @@ os { winnt linux macosx } member? [
                     dup print flush
                     dup parent-directory
                     [ right-trim-separators "yxy" tail? ] either? not
-                ] [ ] [ ] while
+                ] loop
 
                 "c2" get count-down
             ] "Monitor test thread" spawn drop

extra/locals/locals.factor

@@ -64,8 +64,8 @@ C: <quote> quote
     local-index 1+ [ get-local ] curry ;
 
 : localize-writer ( obj args -- quot )
-  >r "local-reader" word-prop r>
+    >r "local-reader" word-prop r>
-  read-local-quot [ set-local-value ] append ;
+    read-local-quot [ set-local-value ] append ;
 
 : localize ( obj args -- quot )
     {
@@ -275,7 +275,7 @@ M: wlet local-rewrite*
 : parse-locals ( -- vars assoc )
     ")" parse-effect
     word [ over "declared-effect" set-word-prop ] when*
-    effect-in make-locals dup push-locals ;
+    in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
 
 : parse-locals-definition ( word -- word quot )
     scan "(" assert= parse-locals \ ; (parse-lambda) <lambda>

extra/math/functions/functions.factor

@@ -23,12 +23,12 @@ GENERIC: sqrt ( x -- y ) foldable
 M: real sqrt
     >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;
 
-: each-bit ( n quot -- )
+: each-bit ( n quot: ( ? -- ) -- )
     over 0 number= pick -1 number= or [
         2drop
     ] [
         2dup >r >r >r odd? r> call r> 2/ r> each-bit
-    ] if ; inline
+    ] if ; inline recursive
 
 GENERIC: (^) ( x y -- z ) foldable
 

extra/sequences/deep/deep.factor

@@ -10,25 +10,25 @@ IN: sequences.deep
         dup string? swap number? or not
     ] [ drop f ] if ;
 
-: deep-each ( obj quot -- )
+: deep-each ( obj quot: ( elt -- ) -- )
     [ call ] 2keep over branch?
-    [ [ deep-each ] curry each ] [ 2drop ] if ; inline
+    [ [ deep-each ] curry each ] [ 2drop ] if ; inline recursive
 
-: deep-map ( obj quot -- newobj )
+: deep-map ( obj quot: ( elt -- elt' ) -- newobj )
     [ call ] keep over branch?
-    [ [ deep-map ] curry map ] [ drop ] if ; inline
+    [ [ deep-map ] curry map ] [ drop ] if ; inline recursive
 
-: deep-filter ( obj quot -- seq )
+: deep-filter ( obj quot: ( elt -- ? ) -- seq )
     over >r
     pusher >r deep-each r>
-    r> dup branch? [ like ] [ drop ] if ; inline
+    r> dup branch? [ like ] [ drop ] if ; inline recursive
 
-: deep-find-from ( obj quot -- elt ? )
+: deep-find-from ( obj quot: ( elt -- ? ) -- elt ? )
     [ call ] 2keep rot [ drop t ] [
         over branch? [
             f -rot [ >r nip r> deep-find-from ] curry find drop >boolean
         ] [ 2drop f f ] if  
-    ] if ; inline
+    ] if ; inline recursive
 
 : deep-find ( obj quot -- elt ) deep-find-from drop ; inline
 
@@ -37,10 +37,10 @@ IN: sequences.deep
 : deep-all? ( obj quot -- ? )
     [ not ] compose deep-contains? not ; inline
 
-: deep-change-each ( obj quot -- )
+: deep-change-each ( obj quot: ( elt -- elt' ) -- )
     over branch? [ [
         [ call ] keep over >r deep-change-each r>
-    ] curry change-each ] [ 2drop ] if ; inline
+    ] curry change-each ] [ 2drop ] if ; inline recursive
 
 : flatten ( obj -- seq )
     [ branch? not ] deep-filter ;

extra/sorting/insertion/insertion.factor

@@ -2,13 +2,13 @@ USING: locals sequences kernel math ;
 IN: sorting.insertion
 
 <PRIVATE
-:: insert ( seq quot n -- )
+:: insert ( seq quot: ( elt -- elt' ) n -- )
     n zero? [
         n n 1- [ seq nth quot call ] bi@ >= [
             n n 1- seq exchange
             seq quot n 1- insert
         ] unless
-    ] unless ; inline
+    ] unless ; inline recursive
 PRIVATE>
 
 : insertion-sort ( seq quot -- )

extra/ui/cocoa/cocoa.factor

@@ -16,10 +16,7 @@ SINGLETON: cocoa-ui-backend
 
 M: cocoa-ui-backend do-events ( -- )
     [
-        [
+        [ NSApp [ do-event ] curry loop ui-wait ] ui-try
-            NSApp [ dup do-event ] [ ] [ ] while drop
-            ui-wait
-        ] ui-try
     ] with-autorelease-pool ;
 
 TUPLE: pasteboard handle ;

extra/ui/freetype/freetype.factor

@@ -142,7 +142,7 @@ M: freetype-renderer string-height ( open-font string -- h )
     i end < [
         i j bitmap texture copy-pixel
             bitmap texture end (copy-row)
-    ] when ; inline
+    ] when ; inline recursive
 
 :: copy-row ( i j bitmap texture width width2 -- i j )
     i j bitmap texture i width + (copy-row)