Adding inline recursive declarations

diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index 6cb89582987820dbe8b163e5cda5db06a676d666..be796ca5541c63c5fd6236e49e86783885d3c242 100755 (executable)
--- a/core/assocs/assocs.factor
+++ b/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) ;

diff --git a/core/binary-search/binary-search.factor b/core/binary-search/binary-search.factor
index 87a4e0f5036a14932c8866fa32c17aced4f6ed51..2863944c8b04b730882fc5e161e0d42f8d11b5dc 100644 (file)
--- a/core/binary-search/binary-search.factor
+++ b/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>
 

diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor
index 940b8ba57d1a5df1be7652f63061025a31473615..e7dd333ed8e90e03592d5c520d5237904b0fb963 100755 (executable)
--- a/core/bootstrap/syntax.factor
+++ b/core/bootstrap/syntax.factor
@@ -59,6 +59,7 @@ IN: bootstrap.syntax
     "flushable"
     "foldable"
     "inline"
+    "recursive"
     "parsing"
     "t"
     "{"

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index 0e04042beac5e019ef1206d3ed2190fec92ebf3f..10324224b6336ff53b36aaf427971b189be01e51 100755 (executable)
--- a/core/combinators/combinators.factor
+++ b/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 )
-    spin [ length <buckets> ] keep
-    [ >r 2dup r> dup first roll call (distribute-buckets) ] each
-    nip ; inline
+: distribute-buckets ( alist initial quot -- buckets )
+    swapd [ >r dup first r> call 2array ] curry map
+    [ length <buckets> dup ] keep
+    [ first2 (distribute-buckets) ] with each ; inline
 
 : hash-case-table ( default assoc -- array )
     V{ } [ 1array ] distribute-buckets

diff --git a/core/dequeues/dequeues.factor b/core/dequeues/dequeues.factor
index 67c87d79c3aa668029a207c527668d25a5fec5c9..ae55c57fe5c484c1669dc1ecf8995b4fe3a531d9 100644 (file)
--- a/core/dequeues/dequeues.factor
+++ b/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 ] [
-        [ [ pop-back ] dip call ] [ slurp-dequeue ] 2bi
-    ] if ; inline
+    [ drop [ dequeue-empty? not ] curry ]
+    [ [ pop-back ] prepose curry ] 2bi [ ] while ; inline
 
 MIXIN: dequeue

diff --git a/core/dlists/dlists.factor b/core/dlists/dlists.factor
index 0095734e63a29d1d906ef240ebb8b2315c5ada98..370ec4042f181d1e76d9818610dce8deff3259a4 100755 (executable)
--- a/core/dlists/dlists.factor
+++ b/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

diff --git a/core/effects/effects.factor b/core/effects/effects.factor
index 6aee6fbcb231756a4bc58c208e35ac44b0a4bb63..c221ad073b27418649b40d17bf860494658b338f 100755 (executable)
--- a/core/effects/effects.factor
+++ b/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 )
-M: string (stack-picture) ;
-M: word (stack-picture) name>> ;
-M: integer (stack-picture) drop "object" ;
+GENERIC: effect>string ( obj -- str )
+M: string effect>string ;
+M: word effect>string name>> ;
+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* ;
 

diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor
index 8f28450de78cd4237f43f79234a7a1dd015d0264..93401d321c73ba4585ea1fb97aebb15b33cef801 100644 (file)
--- a/core/effects/parser/parser.factor
+++ b/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 )
-    parse-tokens dup { "(" "((" } intersect empty? [
-        { "--" } split1 dup [
-            <effect>
-        ] [
-            "Stack effect declaration must contain --" throw
+DEFER: parse-effect
+
+ERROR: bad-effect ;
+
+M: bad-effect summary
+    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 ;

diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index 3aecd4825e344b272174290fe136c7305910dfc1..a621c7fa91fde16b10928887209541178a534cb4 100755 (executable)
--- a/core/generic/generic.factor
+++ b/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 ;
 

diff --git a/core/generic/standard/engines/tuple/tuple.factor b/core/generic/standard/engines/tuple/tuple.factor
index 6f1773a21f34d33036b9e1cadd8be0b2a23a7a2e..325f2ebb394bc8754d925b78a81c9b692a662805 100644 (file)
--- a/core/generic/standard/engines/tuple/tuple.factor
+++ b/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 ;

diff --git a/core/graphs/graphs.factor b/core/graphs/graphs.factor
index 792b2ab340a6051c565aaafd62dc8b4fd8860ced..f2003641de3408d9b5da2e3dda840fd15a454c5c 100644 (file)
--- a/core/graphs/graphs.factor
+++ b/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 [

diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor
index 943071a9f8dbc4f943546e73020062ae650040d9..32fda7d2fb02a8d329f2a742a3a0f5c5618d19d5 100755 (executable)
--- a/core/hashtables/hashtables.factor
+++ b/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

diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor
index b4a533597cecb0726724938ccd3d4cf8de7fac5c..054315990313077774f7bdb1aae780cc55c99899 100755 (executable)
--- a/core/inference/backend/backend.factor
+++ b/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

diff --git a/core/inference/class/class-tests.factor b/core/inference/class/class-tests.factor
index 7be70f1ad4bae1ccdfcc7bdcb3e9723912fba8ba..a133f008e4ca3c229900b9335b04ae36542b6619 100755 (executable)
--- a/core/inference/class/class-tests.factor
+++ b/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 ] [

diff --git a/core/inference/dataflow/dataflow.factor b/core/inference/dataflow/dataflow.factor
index 734c1c551cc171155f061574fa0eadac04b858a8..14383538939a066bcae261cf3c8ecc51ff321da9 100755 (executable)
--- a/core/inference/dataflow/dataflow.factor
+++ b/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 [

diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor
index c56c8ed080a4d00c3cbe9e9804f81c7b9248a703..c757ff4e96f30b6e1a35cdc64ddf73adb7db5341 100755 (executable)
--- a/core/inference/transforms/transforms.factor
+++ b/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 ;

diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 0181f80af444999c5c52743d3fda5c14253c4d89..fc02d880f157725e295c88b8bdb2755b41005b43 100755 (executable)
--- a/core/io/encodings/encodings.factor
+++ b/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 )
-    ! quot: -- char stop?
+: ((read-until)) ( buf quot: ( -- char stop? ) -- string/f sep/f )
     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

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 6b785a61ba5db03e0999d6ce46c513bc20a3a522..2540ee39cdcf2f89243c1043a40a2fa2a42a356d 100755 (executable)
--- a/core/kernel/kernel.factor
+++ b/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 )

diff --git a/core/listener/listener.factor b/core/listener/listener.factor
index 4e2a8c768e347d18c3606b4cd0000c5e69f3bd20..5ff5830e7a359cd56fad2e8dc631c78d1a2e9118 100755 (executable)
--- a/core/listener/listener.factor
+++ b/core/listener/listener.factor
@@ -59,9 +59,7 @@ SYMBOL: error-hook
     ] recover ;
 
 : until-quit ( -- )
-    quit-flag get
-    [ quit-flag off ]
-    [ listen until-quit ] if ; inline
+    quit-flag get [ quit-flag off ] [ listen until-quit ] if ;
 
 : listener ( -- )
     [ until-quit ] with-interactive-vocabs ;

diff --git a/core/math/bitfields/bitfields-tests.factor b/core/math/bitfields/bitfields-tests.factor
index 248001277371f55ee57a4e0c22ce2e22c8a8d0d2..8864b645327243a78b31657f976aa6eb62cb28f8 100755 (executable)
--- a/core/math/bitfields/bitfields-tests.factor
+++ b/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

diff --git a/core/math/bitfields/bitfields.factor b/core/math/bitfields/bitfields.factor
index a0fb17ef4882402ced25a101befab4259e07a7ae..64ae60d5b3882597d54b351c1efce56c33aa821b 100644 (file)
--- a/core/math/bitfields/bitfields.factor
+++ b/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

diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor
index 6563a1cd11745fe0a5041ca2a0d35b5168cf33fc..1e27d5f16c5255a148e84842ee631359f0140ad7 100755 (executable)
--- a/core/math/integers/integers.factor
+++ b/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) ;
 

diff --git a/core/math/math.factor b/core/math/math.factor
index 859d0f6f29717b91e0e4d68f4c28cfb1cee92315..457dddceeb49940caf78275e64cdb6876be03dcd 100755 (executable)
--- a/core/math/math.factor
+++ b/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

diff --git a/core/memory/memory.factor b/core/memory/memory.factor
index 0d684c3261de5b797f1ad3569384f59723467718..227aa1f9dcb2f5fb5c39cc2ab485986b472e722f 100644 (file)
--- a/core/memory/memory.factor
+++ b/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 -- )
-    next-object dup
-    [ swap [ call ] keep (each-object) ] [ 2drop ] if ; inline
+: (each-object) ( quot: ( obj -- ) -- )
+    [ next-object dup ] swap [ drop ] while ; inline
 
 : each-object ( quot -- )
     begin-scan (each-object) end-scan ; inline

diff --git a/core/optimizer/control/control.factor b/core/optimizer/control/control.factor
index f3f9f519911c96d24e215df289c5c28c1534eee5..feb5706d97aa2f2708d7f774d37857d3a0dd9883 100755 (executable)
--- a/core/optimizer/control/control.factor
+++ b/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

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 07900a900db15a1182ac42767a4d903f20bdc846..349d68adc551a03bc351b81550bff7aa1765d272 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/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 ;

diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor
index 8b84ea8fe0d9ad517d499e671ca31ac439e99b4f..b7bb71f6021546ff97a8efb225868c00ab1eca0d 100755 (executable)
--- a/core/sorting/sorting.factor
+++ b/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
-    [ pick seq>> length pick > ]
-    [ [ dup ] [ 1 shift ] [ ] tri* [ sort-pass ] 2keep ]
-    [ ] while 3drop ; inline
+    [ 2 [ over seq>> length over > ] ] dip
+    [ [ 1 shift 2dup ] dip sort-pass ] curry
+    [ ] while 2drop ; inline
 
 : each-pair ( seq quot -- )
     [ [ length 1+ 2/ ] keep ] dip

diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor
index c30ea462c10f751aa10b879f94fa9e8d6aa27450..38f5ae08912111b7e60c5ce1edad8be9d31e9f85 100755 (executable)
--- a/core/splitting/splitting.factor
+++ b/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) ;
 

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index e8ee8578777d8cc82992523ab6004fac33f186f5..54df692895df007147f79cf4de2f7a8a31bce58a 100755 (executable)
--- a/core/syntax/syntax.factor
+++ b/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

diff --git a/core/threads/threads.factor b/core/threads/threads.factor
index 552d64cfe77302977e086a0997f34d9af82fc602..4b32f4519d92745382aea32e597d91a861b6f811 100755 (executable)
--- a/core/threads/threads.factor
+++ b/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>

diff --git a/core/words/words.factor b/core/words/words.factor
index 1d84acbc1404ce0b9ff56f21960db4615cb81d99..5cf15abfa4d1a91fdc83c33a6ed4d1e5f595082a 100755 (executable)
--- a/core/words/words.factor
+++ b/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 -- ? )

diff --git a/extra/cocoa/enumeration/enumeration.factor b/extra/cocoa/enumeration/enumeration.factor
index 0cd8e905319cc73204942c928bc3cdeac210de32..765fb65ef2a43c527ebaa13c3075c219d83ad6ae 100644 (file)
--- a/extra/cocoa/enumeration/enumeration.factor
+++ b/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

diff --git a/extra/concurrency/mailboxes/mailboxes.factor b/extra/concurrency/mailboxes/mailboxes.factor
index d0d6afef3f1f6ef51d12d9b7eeaa2e6e9db2e573..b7d9e46aa8273a81a93af7a812797ea06a730bd6 100755 (executable)
--- a/extra/concurrency/mailboxes/mailboxes.factor
+++ b/extra/concurrency/mailboxes/mailboxes.factor
@@ -23,13 +23,13 @@ M: mailbox dispose* threads>> notify-all ;
 : wait-for-mailbox ( mailbox timeout -- )\r
     >r threads>> r> "mailbox" wait ;\r
 \r
-: block-unless-pred ( mailbox timeout pred -- )\r
+: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )\r
     pick check-disposed\r
     pick data>> over dlist-contains? [\r
         3drop\r
     ] [\r
         >r 2dup wait-for-mailbox r> block-unless-pred\r
-    ] if ; inline\r
+    ] if ; inline recursive\r
 \r
 : block-if-empty ( mailbox timeout -- mailbox )\r
     over check-disposed\r
@@ -58,11 +58,7 @@ M: mailbox dispose* threads>> notify-all ;
     f mailbox-get-all-timeout ;\r
 \r
 : while-mailbox-empty ( mailbox quot -- )\r
-    over mailbox-empty? [\r
-        dup >r dip r> while-mailbox-empty\r
-    ] [\r
-        2drop\r
-    ] if ; inline\r
+    [ [ mailbox-empty? ] curry ] dip [ ] while ; inline\r
 \r
 : mailbox-get-timeout? ( mailbox timeout pred -- obj )\r
     3dup block-unless-pred\r

diff --git a/extra/concurrency/messaging/messaging-tests.factor b/extra/concurrency/messaging/messaging-tests.factor
index 929c4d44f49611ed3cb45322c5d4560f8e21f34b..f78287078329890dd21a0c49a7439375a5b95bbe 100755 (executable)
--- a/extra/concurrency/messaging/messaging-tests.factor
+++ b/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

diff --git a/extra/io/monitors/monitors-tests.factor b/extra/io/monitors/monitors-tests.factor
index bd339544363a40c7020ec0288c244bab956bc999..63381811d1d5c7260c3fcb9710e795b604ba802f 100755 (executable)
--- a/extra/io/monitors/monitors-tests.factor
+++ b/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

diff --git a/extra/locals/locals.factor b/extra/locals/locals.factor
index 8346c2c2c3cd5532dcaa39cd78af6745105a3aa0..f80af233d7f2211f859ea2b893908072ccdc4c0c 100755 (executable)
--- a/extra/locals/locals.factor
+++ b/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>
-  read-local-quot [ set-local-value ] append ;
+    >r "local-reader" word-prop r>
+    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>

diff --git a/extra/math/functions/functions.factor b/extra/math/functions/functions.factor
index 4dcb21513883de5edd415e2420f4c83293641fc2..4d71b25174e40be25c0c093d7619c6aaa7c5185d 100755 (executable)
--- a/extra/math/functions/functions.factor
+++ b/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
 

diff --git a/extra/sequences/deep/deep.factor b/extra/sequences/deep/deep.factor
index c0e516e47153632566a8680ea0a66d724c5df360..3ec793f458db2762f4099b36db7a7b7ed369f42f 100644 (file)
--- a/extra/sequences/deep/deep.factor
+++ b/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 ;

diff --git a/extra/sorting/insertion/insertion.factor b/extra/sorting/insertion/insertion.factor
index 3a46eb83fd898ad4c17838c5893f60abe7f2f76d..8bc12e270441894929fa3300274244e8ca190181 100644 (file)
--- a/extra/sorting/insertion/insertion.factor
+++ b/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 -- )

diff --git a/extra/ui/cocoa/cocoa.factor b/extra/ui/cocoa/cocoa.factor
index 0085376eaabd8b7936d789743e4699d2f75d5e6c..8d176b9c6308caa23b288c7ba1ee626b0c0a1fe5 100755 (executable)
--- a/extra/ui/cocoa/cocoa.factor
+++ b/extra/ui/cocoa/cocoa.factor
@@ -16,10 +16,7 @@ SINGLETON: cocoa-ui-backend
 
 M: cocoa-ui-backend do-events ( -- )
     [
-        [
-            NSApp [ dup do-event ] [ ] [ ] while drop
-            ui-wait
-        ] ui-try
+        [ NSApp [ do-event ] curry loop ui-wait ] ui-try
     ] with-autorelease-pool ;
 
 TUPLE: pasteboard handle ;

diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor
index 3512bbf67000448202a6af652f298bbb4d687349..85bf5d335e2206341c6697083f7e1d7409adf1ec 100755 (executable)
--- a/extra/ui/freetype/freetype.factor
+++ b/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)