]> gitweb.factorcode.org Git - factor.git/commitdiff
generalize stack effects so we can bootstrap with the stricter stack effect checking
authorJoe Groff <arcata@gmail.com>
Tue, 9 Mar 2010 07:38:10 +0000 (23:38 -0800)
committerJoe Groff <arcata@gmail.com>
Tue, 9 Mar 2010 07:38:10 +0000 (23:38 -0800)
31 files changed:
basis/binary-search/binary-search.factor
basis/circular/circular.factor
basis/cocoa/enumeration/enumeration.factor
basis/compiler/cfg/cfg.factor
basis/compiler/cfg/representations/preferred/preferred.factor
basis/compiler/cfg/representations/representations.factor
basis/compiler/cfg/rpo/rpo.factor
basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor
basis/compiler/cfg/stacks/finalize/finalize.factor
basis/compiler/cfg/tco/tco.factor
basis/compiler/cfg/utilities/utilities.factor
basis/compiler/tree/combinators/combinators.factor
basis/compiler/tree/escape-analysis/nodes/nodes.factor
basis/compiler/tree/recursive/recursive.factor
basis/compression/huffman/huffman.factor
basis/concurrency/mailboxes/mailboxes.factor
basis/dlists/dlists.factor
basis/documents/documents.factor
basis/lists/lists.factor
basis/math/rectangles/rectangles.factor
basis/regexp/regexp.factor
basis/sequences/deep/deep.factor
basis/sequences/parser/parser.factor
basis/sorting/insertion/insertion.factor
basis/stack-checker/backend/backend.factor
basis/tools/disassembler/udis/udis.factor
core/assocs/assocs.factor
core/combinators/combinators.factor
core/generic/math/math.factor
extra/gpu/buffers/buffers.factor
extra/math/matrices/simd/simd.factor

index 89a300202aacf9eab56e106452c58219143bbc63..83bf9f13f41ad1320364400f89471de811e586b5 100644 (file)
@@ -21,7 +21,7 @@ DEFER: (search)
 : keep-searching ( seq quot -- slice )
     [ dup midpoint@ ] dip call collapse-slice slice boa (search) ; inline
 
-: (search) ( quot: ( elt -- <=> ) seq -- i elt )
+: (search) ( ... quot: ( ... elt -- ... <=> ) seq -- ... i elt )
     dup length 1 <= [
         finish
     ] [
index ccb70c617f534f4af67498ae0c51adf91012ad04..0e1fe47fbb658c8e9c4b67d2f9524fb257bc179a 100644 (file)
@@ -64,7 +64,7 @@ TUPLE: circular-iterator
 
 <PRIVATE
 
-: (circular-while) ( iterator quot: ( obj -- ? ) -- )
+: (circular-while) ( ... iterator quot: ( ... obj -- ... ? ) -- ... )
     [ [ [ n>> ] [ circular>> ] bi nth ] dip call ] 2keep
     rot [ [ dup n>> >>last-start ] dip ] when
     over [ n>> ] [ [ last-start>> ] [ circular>> length ] bi + 1 - ] bi = [
@@ -75,5 +75,5 @@ TUPLE: circular-iterator
 
 PRIVATE>
 
-: circular-while ( circular quot: ( obj -- ? ) -- )
+: circular-while ( ... circular quot: ( ... obj -- ... ? ) -- ... )
     [ clone ] dip [ <circular-iterator> ] dip (circular-while) ; inline
index c7bdf625d9e0c5debf04d8c83660fc771037a65a..f4d1053f0ade9758c6be5f7b00de78d763adb695 100644 (file)
@@ -15,7 +15,7 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16
         @
     ] with-destructors ; inline
 
-:: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- )
+:: (NSFastEnumeration-each) ( ... object quot: ( ... elt -- ) state stackbuf count -- ... )
     object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count
     items-count 0 = [
         state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items
@@ -23,10 +23,10 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16
         object quot state stackbuf count (NSFastEnumeration-each)
     ] unless ; inline recursive
 
-: NSFastEnumeration-each ( object quot -- )
+: NSFastEnumeration-each ( ... object quot: ( ... elt -- ... ) -- ... )
     [ (NSFastEnumeration-each) ] with-enumeration-buffers ; inline
 
-: NSFastEnumeration-map ( object quot -- vector )
+: NSFastEnumeration-map ( ... object quot: ( ... elt -- ... newelt ) -- ... vector )
     NS-EACH-BUFFER-SIZE <vector>
     [ '[ @ _ push ] NSFastEnumeration-each ] keep ; inline
 
index 5d815e3b0f06b79edb1fce4524d077ebc5c3f3a2..79f3b0d1fba658e4b25d70612ef8e8a8ddb31c5d 100644 (file)
@@ -39,7 +39,7 @@ predecessors-valid? dominance-valid? loops-valid? ;
 : predecessors-changed ( cfg -- cfg )
     f >>predecessors-valid? ;
 
-: with-cfg ( cfg quot: ( cfg -- ) -- )
+: with-cfg ( ..a cfg quot: ( ..a cfg -- ..b ) -- ..b )
     [ dup cfg ] dip with-variable ; inline
 
 TUPLE: mr { instructions array } word label ;
index 726521cfe1922b4fbfda67de04f296f05f8b319e..9ba78dbf46f62af019cf1e5f754c898a688d1817 100644 (file)
@@ -67,16 +67,16 @@ PRIVATE>
     tri
 ] with-compilation-unit
 
-: each-def-rep ( insn vreg-quot: ( vreg rep -- ) -- )
+: each-def-rep ( ... insn vreg-quot: ( ... vreg rep -- ... ) -- ... )
     [ [ defs-vreg ] [ defs-vreg-rep ] bi ] dip with when* ; inline
 
-: each-use-rep ( insn vreg-quot: ( vreg rep -- ) -- )
+: each-use-rep ( ... insn vreg-quot: ( ... vreg rep -- ... ) -- ... )
     [ [ uses-vregs ] [ uses-vreg-reps ] bi ] dip 2each ; inline
 
-: each-temp-rep ( insn vreg-quot: ( vreg rep -- ) -- )
+: each-temp-rep ( ... insn vreg-quot: ( ... vreg rep -- ... ) -- ... )
     [ [ temp-vregs ] [ temp-vreg-reps ] bi ] dip 2each ; inline
 
-: with-vreg-reps ( cfg vreg-quot: ( vreg rep -- ) -- )
+: with-vreg-reps ( ..a cfg vreg-quot: ( ..a vreg rep -- ..b ) -- ..b )
     '[
         [ basic-block set ] [
             [
index 005fe8c90b3b1a887f102766860862dbfc734d56..b14390e9802be0d540a9301d4abffa28032ad408 100644 (file)
@@ -187,7 +187,7 @@ SYMBOLS: renaming-set needs-renaming? ;
 : record-renaming ( from to -- )
     2array renaming-set get push needs-renaming? on ;
 
-:: (compute-renaming-set) ( vreg required quot: ( vreg preferred required -- ) -- )
+:: (compute-renaming-set) ( ..a vreg required quot: ( ..a vreg preferred required -- ..b ) -- ..b )
     vreg rep-of :> preferred
     preferred required eq?
     [ vreg no-renaming ]
index b6322730ee72bd2a80ff881a8e95f5e17dd0a901..b569327c83648eb1e45041e6f306ab0268954ada 100644 (file)
@@ -38,8 +38,8 @@ SYMBOL: visited
     [ drop basic-block set ]
     [ change-instructions drop ] 2bi ; inline
 
-: local-optimization ( cfg quot: ( insns -- insns' ) -- cfg' )
+: local-optimization ( ... cfg quot: ( ... insns -- ... insns' ) -- ... cfg' )
     dupd '[ _ optimize-basic-block ] each-basic-block ; inline
 
 : needs-post-order ( cfg -- cfg' )
-    dup post-order drop ;
\ No newline at end of file
+    dup post-order drop ;
index 4b459e90fb57749cfc20b43da223217eb1130b5c..837b41e47f2a7820cc1443be210f92604f193265 100644 (file)
@@ -47,7 +47,7 @@ SYMBOLS: visited merge-sets levels again? ;
         tmp dom-parent to tmp walk
     ] [ lnode ] if ;
 
-: each-incoming-j-edge ( bb quot: ( from to -- ) -- )
+: each-incoming-j-edge ( ... bb quot: ( ... from to -- ... ) -- ... )
     [ [ predecessors>> ] keep ] dip
     '[ _ 2dup j-edge? _ [ 2drop ] if ] each ; inline
 
@@ -101,7 +101,7 @@ PRIVATE>
     [ compute-merge-set-loop ]
     tri ;
 
-: merge-set-each ( bbs quot: ( bb -- ) -- )
+: merge-set-each ( ... bbs quot: ( ... bb -- ... ) -- ... )
     [ (merge-set) ] dip '[
         swap _ [ drop ] if
     ] 2each ; inline
index f1f7880c901ed17739a0b51a887ea5653836cb0f..ad3453704bdebee743924575f9e477bca1fbbc4d 100644 (file)
@@ -27,7 +27,7 @@ IN: compiler.cfg.stacks.finalize
     to dead-in to live-in to anticip-in assoc-diff assoc-diff
     assoc-diff ;
 
-: each-insertion ( assoc bb quot: ( vreg loc -- ) -- )
+: each-insertion ( ... assoc bb quot: ( ... vreg loc -- ... ) -- ... )
     '[ drop [ loc>vreg ] [ _ untranslate-loc ] bi @ ] assoc-each ; inline
 
 ERROR: bad-peek dst loc ;
index 810b9010130d47716f9cd3d1a0cad8613efbfd9d..bd8a7cf7540e53a4a4835d5c7beb24860ef730f2 100644 (file)
@@ -29,7 +29,7 @@ IN: compiler.cfg.tco
 : word-tail-call? ( bb -- ? )
     instructions>> penultimate ##call? ;
 
-: convert-tail-call ( bb quot: ( insn -- tail-insn ) -- )
+: convert-tail-call ( ..a bb quot: ( ..a insn -- ..a tail-insn ) -- ..b )
     '[
         instructions>>
         [ pop* ] [ pop ] [ ] tri
@@ -65,4 +65,4 @@ IN: compiler.cfg.tco
 : optimize-tail-calls ( cfg -- cfg' )
     dup [ optimize-tail-call ] each-basic-block
 
-    cfg-changed predecessors-changed ;
\ No newline at end of file
+    cfg-changed predecessors-changed ;
index 3710f4974bf81fd2ea428232eed1a48193873c38..bee2226ec46c07475ac5d45f3923d87deeed276c 100644 (file)
@@ -65,14 +65,14 @@ SYMBOL: visited
 : cfg-has-phis? ( cfg -- ? )
     post-order [ has-phis? ] any? ;
 
-: if-has-phis ( bb quot: ( bb -- ) -- )
+: if-has-phis ( ..a bb quot: ( ..a bb -- ..b ) -- ..b )
     [ dup has-phis? ] dip [ drop ] if ; inline
 
-: each-phi ( bb quot: ( ##phi -- ) -- )
+: each-phi ( ... bb quot: ( ... ##phi -- ... ) -- ... )
     [ instructions>> ] dip
     '[ dup ##phi? [ @ t ] [ drop f ] if ] all? drop ; inline
 
-: each-non-phi ( bb quot: ( insn -- ) -- )
+: each-non-phi ( ... bb quot: ( ... insn -- ... ) -- ... )
     [ instructions>> ] dip
     '[ dup ##phi? [ drop ] _ if ] each ; inline
 
index 1fffa06336e6769c02091750022c32d6741d8395..69c48c5f94f83147f06692ab3f695f14a346ab9c 100644 (file)
@@ -5,7 +5,7 @@ arrays stack-checker.inlining namespaces compiler.tree
 math.order ;
 IN: compiler.tree.combinators
 
-: each-node ( nodes quot: ( node -- ) -- )
+: each-node ( ... nodes quot: ( ... node -- ... ) -- ... )
     dup dup '[
         _ [
             dup #branch? [
@@ -18,7 +18,7 @@ IN: compiler.tree.combinators
         ] bi
     ] each ; inline recursive
 
-: map-nodes ( nodes quot: ( node -- node' ) -- nodes )
+: map-nodes ( ... nodes quot: ( ... node -- ... node' ) -- ... nodes )
     dup dup '[
         @
         dup #branch? [
@@ -30,7 +30,7 @@ IN: compiler.tree.combinators
         ] if
     ] map-flat ; inline recursive
 
-: contains-node? ( nodes quot: ( node -- ? ) -- ? )
+: contains-node? ( ... nodes quot: ( ... node -- ... ? ) -- ... ? )
     dup dup '[
         _ keep swap [ drop t ] [
             dup #branch? [
@@ -49,7 +49,7 @@ IN: compiler.tree.combinators
 : sift-children ( seq flags -- seq' )
     zip [ nip ] assoc-filter keys ;
 
-: until-fixed-point ( #recursive quot: ( node -- ) -- )
+: until-fixed-point ( ... #recursive quot: ( ... node -- ... ) -- ... )
     over label>> t >>fixed-point drop
     [ with-scope ] 2keep
     over label>> fixed-point>> [ 2drop ] [ until-fixed-point ] if ;
index 3451750a344ef656584f8c0bb32a44a5610ee744..4c9dc1ade7cfb0623d19a967a3ea3d899fe59d1c 100644 (file)
@@ -10,7 +10,7 @@ GENERIC: escape-analysis* ( node -- )
 
 SYMBOL: next-node
 
-: each-with-next ( seq quot: ( elt -- ) -- )
+: each-with-next ( ... seq quot: ( ... elt -- ... ) -- ... )
     dupd '[ 1 + _ ?nth next-node set @ ] each-index ; inline
 
 : (escape-analysis) ( node -- )
index bc6243e1381d795b2a937324d12231bd824c55dd..af76cda90384f01f52bb5d81e4a3d26359a234ff 100644 (file)
@@ -102,7 +102,7 @@ SYMBOL: changed?
         recursive-nesting get pop*
     ] each ;
 
-: while-changing ( quot: ( -- ) -- )
+: while-changing ( ... quot: ( ... -- ... ) -- ... )
     changed? off
     [ call ] [ changed? get [ while-changing ] [ drop ] if ] bi ;
     inline recursive
index 9922048009a0ce77f617e6f8c34c9016b36b151f..0c3db049939fb8269b4fa1ba508f79f559fdb1f8 100644 (file)
@@ -30,7 +30,7 @@ TUPLE: huffman-code
     [ free-bits 2^ iota [ huffman-code code>> free-bits 2^ * + ] map ]\r
     [ huffman-code code>> free-bits neg 2^ /i 1array ] if ;\r
 \r
-:: huffman-each ( tdesc quot: ( huffman-code -- ) -- )\r
+:: huffman-each ( ... tdesc quot: ( ... huffman-code -- ... ) -- ... )\r
     <huffman-code> :> code\r
     tdesc\r
     [\r
index 221a5a1fa3457c741d34916826563153e9b47285..e245f93bd5f86f7169668e9a5fb7b5abd5e12852 100644 (file)
@@ -23,7 +23,7 @@ TUPLE: mailbox threads data ;
 : wait-for-mailbox ( mailbox timeout -- )
     [ threads>> ] dip "mailbox" wait ;
 
-:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
+:: block-unless-pred ( ... mailbox timeout pred: ( ... message -- ... ? ) -- ... )
     mailbox data>> pred dlist-any? [
         mailbox timeout wait-for-mailbox
         mailbox timeout pred block-unless-pred
index 317ed81e3e82811e80e464163237b76cbda36c9a..44140d31093a76a07505a6ce01ac5a3edb637264 100644 (file)
@@ -54,16 +54,16 @@ M: dlist-node node-value obj>> ;
 : set-front-to-back ( dlist -- )
     dup front>> [ dup back>> >>front ] unless drop ; inline
 
-: (dlist-find-node) ( dlist-node quot: ( node -- ? ) -- node/f ? )
+: (dlist-find-node) ( ... dlist-node quot: ( ... node -- ... ? ) -- ... node/f ? )
     over [
         [ call ] 2keep rot
         [ drop t ] [ [ next>> ] dip (dlist-find-node) ] if
     ] [ 2drop f f ] if ; inline recursive
 
-: dlist-find-node ( dlist quot -- node/f ? )
+: dlist-find-node ( ... dlist quot: ( ... node -- ... ? ) -- ... node/f ? )
     [ front>> ] dip (dlist-find-node) ; inline
 
-: dlist-each-node ( dlist quot -- )
+: dlist-each-node ( ... dlist quot: ( ... node -- ... ) -- ... )
     '[ @ f ] dlist-find-node 2drop ; inline
 
 : unlink-node ( dlist-node -- )
@@ -114,10 +114,10 @@ M: dlist pop-back* ( dlist -- )
     ] keep
     normalize-front ;
 
-: dlist-find ( dlist quot -- obj/f ? )
+: dlist-find ( ... dlist quot: ( ... value -- ... ? ) -- ... obj/f ? )
     '[ obj>> @ ] dlist-find-node [ obj>> t ] [ drop f f ] if ; inline
 
-: dlist-any? ( dlist quot -- ? )
+: dlist-any? ( ... dlist quot: ( ... value -- ... ? ) -- ... ? )
     dlist-find nip ; inline
 
 M: dlist deque-member? ( value dlist -- ? )
@@ -130,7 +130,7 @@ M: dlist delete-node ( dlist-node dlist -- )
         [ drop unlink-node ]
     } cond ;
 
-: delete-node-if* ( dlist quot -- obj/f ? )
+: delete-node-if* ( ... dlist quot: ( ... value -- ... ? ) -- ... obj/f ? )
     dupd dlist-find-node [
         dup [
             [ swap delete-node ] keep obj>> t
@@ -141,7 +141,7 @@ M: dlist delete-node ( dlist-node dlist -- )
         2drop f f
     ] if ; inline
 
-: delete-node-if ( dlist quot -- obj/f )
+: delete-node-if ( ... dlist quot: ( ... value -- ... ? ) -- ... obj/f )
     '[ obj>> @ ] delete-node-if* drop ; inline
 
 M: dlist clear-deque ( dlist -- )
@@ -149,7 +149,7 @@ M: dlist clear-deque ( dlist -- )
     f >>back
     drop ;
 
-: dlist-each ( dlist quot -- )
+: dlist-each ( ... dlist quot: ( ... value -- ... ) -- ... )
     '[ obj>> @ ] dlist-each-node ; inline
 
 : dlist>seq ( dlist -- seq )
@@ -157,7 +157,7 @@ M: dlist clear-deque ( dlist -- )
 
 : 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
 
-: dlist-filter ( dlist quot -- dlist' )
+: dlist-filter ( ... dlist quot: ( ... value -- ... ? ) -- ... dlist' )
     over [ '[ dup obj>> @ [ drop ] [ _ delete-node ] if ] dlist-each-node ] keep ; inline
 
 M: dlist clone
index dcd1bf5820080ab3225466dd8f76f71a75d98ba2..e84a993eeaadfb4058b9422c9f8068da79585374 100644 (file)
@@ -55,12 +55,12 @@ TUPLE: document < model locs undos redos inside-undo? ;
     to first line# =
     [ to second ] [ line# document doc-line length ] if ;
 
-: each-line ( from to quot -- )
+: each-line ( ... from to quot: ( ... line -- ... ) -- ... )
     2over = [ 3drop ] [
         [ [ first ] bi@ [a,b] ] dip each
     ] if ; inline
 
-: map-lines ( from to quot -- results )
+: map-lines ( ... from to quot: ( ... line -- ... result ) -- ... results )
     collector [ each-line ] dip ; inline
 
 : start/end-on-line ( from to line# document -- n1 n2 )
@@ -109,7 +109,7 @@ CONSTANT: doc-start { 0 0 }
 : entire-doc ( document -- start end document )
     [ [ doc-start ] dip doc-end ] keep ;
 
-: with-undo ( document quot: ( document -- ) -- )
+: with-undo ( ..a document quot: ( ..a document -- ..b ) -- ..b )
     [ t >>inside-undo? ] dip keep f >>inside-undo? drop ; inline
 
 PRIVATE>
index 29adcd47d65d594167bf28a8b261d2555e73c85e..bef9261468b81fc58f118854b559728d7796fdcc 100644 (file)
@@ -55,16 +55,16 @@ M: object nil? drop f ;
 
 PRIVATE>
 
-: leach ( list quot: ( elt -- ) -- )
+: leach ( ... list quot: ( ... elt -- ... ) -- ... )
     over nil? [ 2drop ] [ (leach) leach ] if ; inline recursive
 
-: lmap ( list quot: ( elt -- ) -- result )
+: lmap ( ... list quot: ( ... elt -- ... newelt ) -- ... result )
     over nil? [ drop ] [ (leach) lmap cons ] if ; inline recursive
 
-: foldl ( list identity quot: ( obj1 obj2 -- obj ) -- result )
+: foldl ( ... list identity quot: ( ... obj1 obj2 -- ... obj ) -- ... result )
     swapd leach ; inline
 
-:: foldr ( list identity quot: ( obj1 obj2 -- obj ) -- result )
+:: foldr ( ... list identity quot: ( ... obj1 obj2 -- ... obj ) -- ... result )
     list nil? [ identity ] [
         list cdr identity quot foldr
         list car quot call
@@ -87,7 +87,7 @@ PRIVATE>
 : sequence>list ( sequence -- list )    
     <reversed> nil [ swons ] reduce ;
 
-: lmap>array ( list quot -- array )
+: lmap>array ( ... list quot: ( ... elt -- ... newelt ) -- ... array )
     collector [ leach ] dip { } like ; inline
 
 : list>array ( list -- array )  
index bfde3918841d1e2375f5bbade28e2d9edc940bdd..db3794cbb0edb3ead4e93397b78135d745207b19 100644 (file)
@@ -20,7 +20,7 @@ SYNTAX: RECT: scan-object scan-object <rect> suffix! ;
 
 : rect-center ( rect -- center ) rect-bounds 2 v/n v+ ;
 
-: with-rect-extents ( rect1 rect2 loc-quot: ( loc1 loc2 -- ) ext-quot: ( ext1 ext2 -- ) -- )
+: with-rect-extents ( ..a+b rect1 rect2 loc-quot: ( ..a loc1 loc2 -- ..c ) ext-quot: ( ..b ext1 ext2 -- ..d ) -- ..c+d )
     [ [ rect-extent ] bi@ ] 2dip bi-curry* bi* ; inline
 
 : <extent-rect> ( loc ext -- rect ) over [v-] <rect> ;
index 0b387acd2a9e88658252b606235541fee77a0701..e5ac1df1514b5ea64e02a107306114bb502c15a2 100644 (file)
@@ -69,7 +69,7 @@ PRIVATE>
     dup next-match>>
     execute( i string regexp -- i start end ? ) ; inline
 
-:: (each-match) ( i string regexp quot: ( start end string -- ) -- )
+:: (each-match) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... )
     i string regexp do-next-match [| i' start end |
         start end string quot call
         i' string regexp quot (each-match)
@@ -80,10 +80,10 @@ PRIVATE>
 
 PRIVATE>
 
-: each-match ( string regexp quot: ( start end string -- ) -- )
+: each-match ( ... string regexp quot: ( ... start end string -- ... ) -- ... )
     [ prepare-match-iterator ] dip (each-match) ; inline
 
-: map-matches ( string regexp quot: ( start end string -- obj ) -- seq )
+: map-matches ( ... string regexp quot: ( ... start end string -- ... obj ) -- ... seq )
     collector [ each-match ] dip >array ; inline
 
 : all-matching-slices ( string regexp -- seq )
index c79d0b20029f7490416d23e8831f4027abe033ad..6238962b6c9c4768be13e582a1737b8499836838 100644 (file)
@@ -12,30 +12,30 @@ M: integer branch? drop f ;
 M: string branch? drop f ;
 M: object branch? drop f ;
 
-: deep-each ( obj quot: ( elt -- ) -- )
+: deep-each ( ... obj quot: ( ... elt -- ... ) -- ... )
     [ call ] 2keep over branch?
     [ '[ _ deep-each ] each ] [ 2drop ] if ; inline recursive
 
-: deep-map ( obj quot: ( elt -- elt' ) -- newobj )
+: deep-map ( ... obj quot: ( ... elt -- ... elt' ) -- ... newobj )
     [ call ] keep over branch?
     [ '[ _ deep-map ] map ] [ drop ] if ; inline recursive
 
-: deep-filter ( obj quot: ( elt -- ? ) -- seq )
+: deep-filter ( ... obj quot: ( ... elt -- ... ? ) -- ... seq )
     over [ selector [ deep-each ] dip ] dip
     dup branch? [ like ] [ drop ] if ; inline recursive
 
-: (deep-find) ( obj quot: ( elt -- ? ) -- elt ? )
+: (deep-find) ( ... obj quot: ( ... elt -- ... ? ) -- ... elt ? )
     [ call ] 2keep rot [ drop t ] [
         over branch? [
             [ f ] 2dip '[ nip _ (deep-find) ] find drop >boolean
         ] [ 2drop f f ] if  
     ] if ; inline recursive
 
-: deep-find ( obj quot -- elt ) (deep-find) drop ; inline
+: deep-find ( ... obj quot: ( ... elt -- ... ? ) -- ... elt ) (deep-find) drop ; inline
 
-: deep-any? ( obj quot -- ? ) (deep-find) nip ; inline
+: deep-any? ( ... obj quot: ( ... elt -- ... ? ) -- ... ? ) (deep-find) nip ; inline
 
-: deep-all? ( obj quot -- ? )
+: deep-all? ( ... obj quot: ( ... elt -- ... ? ) -- ... ? )
     '[ @ not ] deep-any? not ; inline
 
 : deep-member? ( obj seq -- ? )
@@ -48,7 +48,7 @@ M: object branch? drop f ;
         _ swap dup branch? [ subseq? ] [ 2drop f ] if
     ] deep-find >boolean ;
 
-: deep-map! ( obj quot: ( elt -- elt' ) -- obj )
+: deep-map! ( ... obj quot: ( ... elt -- ... elt' ) -- ... obj )
     over branch? [
         '[ _ [ call ] keep over [ deep-map! drop ] dip ] map!
     ] [ drop ] if ; inline recursive
index 44fa75239cfa08acbd9e60c48f4730f3fb211641..322d4cf48872a24a3360ca16037cc69d884bf018 100644 (file)
@@ -39,7 +39,7 @@ TUPLE: sequence-parser sequence n ;
 : get+increment ( sequence-parser -- char/f )
     [ current ] [ advance drop ] bi ; inline
 
-:: skip-until ( sequence-parser quot: ( obj -- ? ) -- )
+:: skip-until ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... )
     sequence-parser current [
         sequence-parser quot call
         [ sequence-parser advance quot skip-until ] unless
@@ -47,7 +47,7 @@ TUPLE: sequence-parser sequence n ;
 
 : sequence-parse-end? ( sequence-parser -- ? ) current not ;
 
-: take-until ( sequence-parser quot: ( obj -- ? ) -- sequence/f )
+: take-until ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... sequence/f )
     over sequence-parse-end? [
         2drop f
     ] [
@@ -56,7 +56,7 @@ TUPLE: sequence-parser sequence n ;
         [ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq f like
     ] if ; inline
 
-: take-while ( sequence-parser quot: ( obj -- ? ) -- sequence/f )
+: take-while ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... sequence/f )
     [ not ] compose take-until ; inline
 
 : <safe-slice> ( from to seq -- slice/f )
index b7fefcad635c9d04d381d34fa669a86069db073e..577d2f0b67ebbec00dba5f3b2835aea665427cb9 100644 (file)
@@ -2,7 +2,7 @@ USING: locals sequences kernel math ;
 IN: sorting.insertion
 
 <PRIVATE
-:: insert ( seq quot: ( elt -- elt' ) n -- )
+:: insert ( ... seq quot: ( ... elt -- ... elt' ) n -- ... )
     n zero? [
         n n 1 - [ seq nth quot call ] bi@ >= [
             n n 1 - seq exchange
index 7829f933aa09c22991e0d6ae32a8a2ea12301e48..1e7ae5a9f3a98805ee33e1946a6e7d2039e5124e 100644 (file)
@@ -136,7 +136,7 @@ M: bad-call summary
 : infer-r> ( n -- )
     consume-r dup copy-values [ nip output-d ] [ #r>, ] 2bi ;
 
-: consume/produce ( effect quot: ( inputs outputs -- ) -- )
+: consume/produce ( ..a effect quot: ( ..a inputs outputs -- ..b ) -- ..b )
     '[ [ in>> length consume-d ] [ out>> length produce-d ] bi @ ]
     [ terminated?>> [ terminate ] when ]
     bi ; inline
index ae8827e0933297d4573b655da534b9dfedf623ca..5e46a3468230922928e0ca8cbd3f2f9d2a32e384 100644 (file)
@@ -103,7 +103,7 @@ FUNCTION: c-string ud_lookup_mnemonic ( int c ) ;
     dup cell-bits ud_set_mode
     dup UD_SYN_INTEL ud_set_syntax ;
 
-: with-ud ( quot: ( ud -- ) -- )
+: with-ud ( ..a quot: ( ..a ud -- ..b ) -- ..b )
     [ [ [ <ud> ] dip call ] with-destructors ] with-code-blocks ; inline
 
 SINGLETON: udis-disassembler
index e8ed1637e6a9d6444e07d39107b0af620baf8f18..b0509b27cbee07749bbbb737cba11d0db6885482 100644 (file)
@@ -44,7 +44,7 @@ M: assoc assoc-like drop ; inline
 : substituter ( assoc -- quot )
     [ ?at drop ] curry ; inline
 
-: with-assoc ( assoc quot: ( value key assoc -- ) -- quot: ( key value -- ) )
+: with-assoc ( assoc quot: ( ..a value key assoc -- ..b ) -- quot: ( ..a key value -- ..b ) )
     curry [ swap ] prepose ; inline
 
 PRIVATE>
index 7b9481825bdd8a68cbb08822bd8ed9ad59d54bfa..d14564f7b26845ad8933c563e03dee06ef7ebfa8 100644 (file)
@@ -193,5 +193,5 @@ M: hashtable hashcode*
         [ assoc-hashcode ] [ nip assoc-size ] if
     ] recursive-hashcode ;
 
-: to-fixed-point ( object quot: ( object(n) -- object(n+1) ) -- object(n) )
+: to-fixed-point ( ... object quot: ( ... object(n) -- ... object(n+1) ) -- ... object(n) )
     [ keep over = ] keep [ to-fixed-point ] curry unless ; inline recursive
index 297684014bb9a281297600d034b6092440e4db58..277f40c34fc673a07c8dc4c1e38c6f4c57ffd846 100644 (file)
@@ -74,7 +74,7 @@ PRIVATE>
 
 SYMBOL: generic-word
 
-: make-math-method-table ( classes quot: ( class -- quot ) -- alist )
+: make-math-method-table ( classes quot: ( ... class -- ... quot ) -- alist )
     [ bootstrap-words ] dip
     [ [ drop ] [ call ] 2bi ] curry { } map>assoc ; inline
 
@@ -93,7 +93,7 @@ SYMBOL: generic-word
 : tuple-dispatch ( picker alist -- alist' )
     swap [ [ tuple-dispatch-entry ] curry dip ] curry assoc-map math-alist>quot ;
 
-: math-dispatch-step ( picker quot: ( class -- quot ) -- quot )
+: math-dispatch-step ( picker quot: ( ... class -- ... quot ) -- quot )
     [ [ { bignum float fixnum } ] dip make-math-method-table ]
     [ [ { ratio complex } ] dip make-math-method-table tuple-dispatch ] 2bi
     tuple swap 2array prefix tag-dispatch ; inline
index bc6f089db95885871aec1796b5e83a71caafd2a4..1f764cdfec7286cd4fc779603fad78c48fa27c07 100644 (file)
@@ -132,7 +132,7 @@ TYPED:: copy-buffer ( to-buffer-ptr: buffer-ptr from-buffer-ptr: buffer-ptr size
     from-buffer-ptr offset>> to-buffer-ptr offset>>
     size glCopyBufferSubData ;
 
-:: with-mapped-buffer ( buffer access quot: ( alien -- ) -- )
+:: with-mapped-buffer ( ..a buffer access quot: ( ..a alien -- ..b ) -- ..b )
     buffer bind-buffer :> target
     target access gl-access glMapBuffer
 
@@ -140,15 +140,15 @@ TYPED:: copy-buffer ( to-buffer-ptr: buffer-ptr from-buffer-ptr: buffer-ptr size
 
     target glUnmapBuffer drop ; inline
 
-:: with-bound-buffer ( buffer target quot: ( -- ) -- )
+:: with-bound-buffer ( ..a buffer target quot: ( ..a -- ..b ) -- ..b )
     target gl-target buffer glBindBuffer
     quot call ; inline
 
-: with-buffer-ptr ( buffer-ptr target quot: ( c-ptr -- ) -- )
+: with-buffer-ptr ( ..a buffer-ptr target quot: ( ..a c-ptr -- ..b ) -- ..b )
     [ [ offset>> <alien> ] [ buffer>> handle>> ] bi ] 2dip
     with-bound-buffer ; inline
 
-: with-gpu-data-ptr ( gpu-data-ptr target quot: ( c-ptr -- ) -- )
+: with-gpu-data-ptr ( ..a gpu-data-ptr target quot: ( ..a c-ptr -- ..b ) -- ..b )
     pick buffer-ptr?
     [ with-buffer-ptr ]
     [ [ gl-target 0 glBindBuffer ] dip call ] if ; inline
index 01d831d6b0bc34541abbcab1879cc0b5be6d5870..26ad8bb4d7549fb7eadf946bbe23284d5a48e63f 100644 (file)
@@ -28,7 +28,7 @@ M: matrix4 new-sequence 2drop matrix4 (struct) ; inline
     c1 c2 c3 c4 columns 4 set-firstn-unsafe
     c ; inline
 
-: make-matrix4 ( quot: ( -- c1 c2 c3 c4 ) -- c )
+: make-matrix4 ( ..a quot: ( ..a -- ..b c1 c2 c3 c4 ) -- ..b c )
     matrix4 (struct) swap dip set-columns ; inline
 
 :: 2map-columns ( a b quot -- c )
@@ -42,7 +42,7 @@ M: matrix4 new-sequence 2drop matrix4 (struct) ; inline
         a4 b4 quot call
     ] make-matrix4 ; inline
 
-: map-columns ( a quot -- c )
+: map-columns ( ... a quot: ( ... col -- ... newcol ) -- ... c )
     '[ columns _ 4 napply ] make-matrix4 ; inline
     
 PRIVATE>