]> gitweb.factorcode.org Git - factor.git/commitdiff
Adding stack effects.
authorJohn Benediktsson <mrjbq7@gmail.com>
Fri, 23 Sep 2011 00:19:51 +0000 (17:19 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sat, 24 Sep 2011 00:46:40 +0000 (17:46 -0700)
13 files changed:
basis/grouping/grouping.factor
basis/sequences/product/product.factor
basis/sorting/insertion/insertion.factor
basis/sorting/slots/slots.factor
basis/splitting/monotonic/monotonic.factor
basis/threads/threads.factor
basis/ui/ui.factor
core/math/math.factor
core/math/order/order.factor
core/sets/sets.factor
core/sorting/sorting.factor
core/splitting/splitting.factor
core/words/words.factor

index 1a7e267c9088827279fb2c99e9ac289050d78f0a..1b2563992d727adc0acc90d8e0fcafe4a73d63d0 100644 (file)
@@ -99,7 +99,7 @@ INSTANCE: sliced-clumps abstract-clumps
 
 : clump ( seq n -- array ) <clumps> { } like ;
 
-: monotonic? ( seq quot -- ? )
+: monotonic? ( seq quot: ( obj1 obj2 -- ? ) -- ? )
     over length 2 < [ 2drop t ] [
         over length 2 = [
             [ first2-unsafe ] dip call
index b8865c7e4af2fa226f778e701389989f33bcb9d6..b358a3eacd903e153cdd3f955e2416091bb50cf7 100644 (file)
@@ -34,7 +34,7 @@ M: product-sequence length lengths>> product ;
 
 : carry-ns ( ns lengths -- )
     0 (carry-n) ;
-    
+
 : product-iter ( ns lengths -- )
     [ 0 over [ 1 + ] change-nth ] dip carry-ns ;
 
@@ -46,17 +46,17 @@ M: product-sequence length lengths>> product ;
 
 PRIVATE>
 
-M: product-sequence nth 
+M: product-sequence nth
     product@ nths ;
 
-:: product-each ( sequences quot -- )
+:: product-each ( sequences quot: ( seq -- ) -- )
     sequences start-product-iter :> ( ns lengths )
     lengths [ 0 = ] any? [
         [ ns lengths end-product-iter? ]
         [ ns sequences nths quot call ns lengths product-iter ] until
     ] unless ; inline
 
-:: product-map-as ( sequences quot exemplar -- sequence )
+:: product-map-as ( sequences quot: ( seq -- value ) exemplar -- sequence )
     0 :> i!
     sequences [ length ] [ * ] map-reduce exemplar
     [| result |
@@ -64,10 +64,10 @@ M: product-sequence nth
         result
     ] new-like ; inline
 
-: product-map ( sequences quot -- sequence )
+: product-map ( sequences quot: ( seq -- value ) -- sequence )
     over product-map-as ; inline
 
-:: product-map>assoc ( sequences quot exemplar -- assoc )
+:: product-map>assoc ( sequences quot: ( seq -- key value ) exemplar -- assoc )
     0 :> i!
     sequences [ length ] [ * ] map-reduce { }
     [| result |
index 577d2f0b67ebbec00dba5f3b2835aea665427cb9..0615893f078e69d54831bf8a8413cd576a1f61b6 100644 (file)
@@ -11,6 +11,6 @@ IN: sorting.insertion
     ] unless ; inline recursive
 PRIVATE>
 
-: insertion-sort ( seq quot -- )
+: insertion-sort ( ... seq quot: ( ... elt -- ... elt' ) -- ... )
     ! quot is a transformation on elements
     over length [ insert ] with with each-integer ; inline
index e3b4bc88caea03974b29ce7d871834482790f61c..959fd8bfd50cc1dfd160e71fd6acc283f0616e92 100644 (file)
@@ -18,7 +18,7 @@ IN: sorting.slots
         ] when execute-comparator
     ] with with map-find drop +eq+ or ;
 
-: sort-by-with ( seq sort-specs quot -- seq' )
+: sort-by-with ( seq sort-specs quot: ( obj -- key ) -- seq' )
     swap '[ _ bi@ _ compare-slots ] sort ; inline
 
 : sort-by ( seq sort-specs -- seq' ) [ ] sort-by-with ;
index 32bb8b46c6edf5ff46297dc20c70ff820202e2d8..e3f08659b7027971e7c9db9f664a9995d247d476 100644 (file)
@@ -18,7 +18,7 @@ IN: splitting.monotonic
 
 PRIVATE>
 
-: monotonic-split ( seq quot -- newseq )
+: monotonic-split ( seq quot: ( obj1 obj2 -- ? ) -- newseq )
     over empty? [ 2drop { } ] [ (monotonic-split) ] if ; inline
 
 <PRIVATE
@@ -36,7 +36,7 @@ PRIVATE>
 
 PRIVATE>
 
-: monotonic-slice ( seq quot class -- slices )
+: monotonic-slice ( seq quot: ( obj1 obj2 -- ? ) class -- slices )
     pick length {
         { 0 [ 2drop ] }
         { 1 [ nip [ 0 1 rot ] dip boa 1array ] }
index 4ab462ff66fe7a13e1ed4ff9c4afe0fa87f37706..30444036146ead8c685bfe568be33933caf9afef 100644 (file)
@@ -75,7 +75,7 @@ sleep-entry ;
 : tset ( value key -- )
     tnamespace set-at ;
 
-: tchange ( key quot -- )
+: tchange ( ..a key quot: ( ..a value -- ..b newvalue ) -- ..b )
     [ tnamespace ] dip change-at ; inline
 
 : threads ( -- assoc )
index 47f674bbcdf212c2a3e4ad612c5e52fcf5e3b619..9837938c0a68c6cd0e0027be861bbd4fa9fab4be 100644 (file)
@@ -142,7 +142,7 @@ SYMBOL: ui-thread
 
 PRIVATE>
 
-: find-window ( quot -- world )
+: find-window ( quot: ( world -- ? ) -- world )
     [ windows get values ] dip
     '[ dup children>> [ ] [ nip first ] if-empty @ ]
     find-last nip ; inline
index e8f2813a959418d2408c37b5d2815a7edae7b8e0..533295b6fcea1020955faf1659ec342b3e9b18ca 100644 (file)
@@ -76,9 +76,9 @@ ERROR: log2-expects-positive x ;
 : if-zero ( ..a n quot1: ( ..a -- ..b ) quot2: ( ..a n -- ..b ) -- ..b )
     [ dup zero? ] [ [ drop ] prepose ] [ ] tri* if ; inline
 
-: when-zero ( n quot -- ) [ ] if-zero ; inline
+: when-zero ( ..a n quot: ( ..a -- ..b ) -- ..b ) [ ] if-zero ; inline
 
-: unless-zero ( n quot -- ) [ ] swap if-zero ; inline
+: unless-zero ( ..a n quot: ( ..a -- ..b ) -- ..b ) [ ] swap if-zero ; inline
 
 UNION: integer fixnum bignum ;
 
index 499cf06e9a6394d04d514331a88dc7f2c2949580..a9013b500170264081f3861012d61ef3cd4e4111 100644 (file)
@@ -45,4 +45,4 @@ M: object max [ after? ] most ; inline
 
 : [-] ( x y -- z ) - 0 max ; inline
 
-: compare ( obj1 obj2 quot -- <=> ) bi@ <=> ; inline
+: compare ( obj1 obj2 quot: ( obj -- newobj ) -- <=> ) bi@ <=> ; inline
index e5db8b2946e93fcb06ac3b21a2a7b8daf5eaee21..3b5192b008e00f7f7b493d164d2b283d785e90ef 100644 (file)
@@ -121,7 +121,7 @@ M: sequence cardinality
     [ [ [ members ] map concat ] [ first ] bi set-like ]
     if-empty ;
 
-: gather ( seq quot -- newseq )
+: gather ( ... seq quot: ( ... elt -- ... elt' ) -- ... newseq )
     map concat members ; inline
 
 : adjoin-at ( value key assoc -- )
index b26a34b41ee677cf358499dd95ee61659168ec81..2863f7add7ff45313417deee001ff67e98a8d579 100644 (file)
@@ -148,16 +148,17 @@ TUPLE: merge
 
 PRIVATE>
 
-: sort ( seq quot -- sortedseq )
+: sort ( seq quot: ( obj1 obj2 -- <=> ) -- sortedseq )
     [ <merge> ] dip
     [ sort-pairs ] [ sort-loop ] [ drop accum>> underlying>> ] 2tri ;
     inline
 
 : natural-sort ( seq -- sortedseq ) [ <=> ] sort ;
 
-: sort-with ( seq quot -- sortedseq )
+: sort-with ( seq quot: ( elt -- key ) -- sortedseq )
     [ compare ] curry sort ; inline
-: inv-sort-with ( seq quot -- sortedseq )
+
+: inv-sort-with ( seq quot: ( elt -- key ) -- sortedseq )
     [ compare invert-comparison ] curry sort ; inline
 
 GENERIC: sort-keys ( obj -- sortedseq )
index c2ba53f1b67955a6819cf757d41dc6e318bd254d..2011a24428325555a786dcddcc952835eafb98f1 100644 (file)
@@ -68,7 +68,7 @@ PRIVATE>
 : split ( seq separators -- pieces )
     [ [ member? ] curry split, ] { } make ;
 
-: split-when ( seq quot -- pieces )
+: split-when ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
     [ split, ] { } make ; inline
 
 GENERIC: string-lines ( str -- seq )
index 46841af079b2f9e1fc0597077dd0b74fc4faadb1..3fa4baaff817952b54e2e33f2d89d3c3bf4eab80 100644 (file)
@@ -31,7 +31,7 @@ M: word definition def>> ;
     [ pick props>> ?set-at >>props drop ]
     [ nip remove-word-prop ] if ;
 
-: change-word-prop ( word prop quot -- )
+: change-word-prop ( ..a word prop quot: ( ..a value -- ..b newvalue ) -- ..b )
     [ swap props>> ] dip change-at ; inline
 
 : reset-props ( word seq -- ) [ remove-word-prop ] with each ;