More work on stack effect declaration

TODO.FACTOR.txt

@@ -1,17 +1,13 @@
 + 0.84:
 
 - declaration to do:
-  - move effect class to words vocab
-  - stack-effect word in words needs to be fixed
   - test what is done in the case of an invalid declaration on an inline
     recursive
-  - see should show declared effects
-  - get rid of the string "stack-effect" prop
   - HELP: should not specify stack effect
   - bootstrap speedup with compiling recursives
   - load cocoa before 'recompile' call
   - document inference errors
-  - maybe we can remove |
+  - update docs for declared effects
 - RT_WORD should refer to XTs not word objects.
 - fix contribs: boids, automata
 - sometimes darcs get fails with the httpd

library/bootstrap/boot-stage1.factor

@@ -65,6 +65,7 @@ sequences vectors words ;
 
         "/library/definitions.factor"
         "/library/words.factor"
+        "/library/effects.factor"
         "/library/continuations.factor"
         "/library/errors.factor"
         

library/bootstrap/image.factor

@@ -187,7 +187,6 @@ M: f '
     [ % dup word-vocabulary % " " % word-name % ] "" make throw ;
 
 : transfer-word ( word -- word )
-    #! This is a hack. See doc/bootstrap.txt.
     dup target-word [ ] [ "Missing DEFER: " word-error ] ?if ;
 
 : fixup-word ( word -- offset )

library/collections/graphs.factor

@@ -5,13 +5,13 @@ USING: hashtables kernel namespaces sequences ;
 
 : if-graph over [ bind ] [ 2drop 2drop ] if ; inline
 
-: (add-vertex) ( vertex edges -- | edges: vertex -- seq )
+: (add-vertex) ( vertex edges -- )
     dupd call [ dupd nest set-hash ] each-with ; inline
 
-: add-vertex ( vertex edges graph -- | edges: vertex -- seq )
+: add-vertex ( vertex edges graph -- )
     [ (add-vertex) ] if-graph ; inline
 
-: build-graph ( seq edges graph -- | edges: vertex -- seq )
+: build-graph ( seq edges graph -- )
     [
         namespace clear-hash
         swap [ swap (add-vertex) ] each-with
@@ -37,7 +37,7 @@ SYMBOL: previous
         [ call ] keep swap [ swap (closure) ] each-with
     ] if ; inline
 
-: closure ( obj quot -- seq | quot: obj -- seq )
+: closure ( obj quot -- seq )
     [
         H{ } clone previous set
         (closure)

library/collections/growable.factor

@@ -6,9 +6,9 @@ IN: sequences-internals
 USING: errors kernel kernel-internals math math-internals
 sequences ;
 
-GENERIC: underlying
-GENERIC: set-underlying
-GENERIC: set-fill
+GENERIC: underlying ( seq -- underlying )
+GENERIC: set-underlying ( underlying seq -- )
+GENERIC: set-fill ( n seq -- )
 
 : capacity ( seq -- n ) underlying length ; inline
 

library/collections/hashtables.factor

@@ -30,7 +30,7 @@ TUPLE: tombstone ;
 : key@ ( key hash -- n )
     hash-array 2dup hash@ (key@) ; inline
 
-: if-key ( key hash true false -- ) | true ( index key hash -- )
+: if-key ( key hash true false -- )
     >r >r [ key@ ] 2keep pick -1 > r> r> if ; inline
 
 : <hash-array> ( n -- array )
@@ -77,7 +77,7 @@ TUPLE: tombstone ;
     [ hash-array 2dup array-nth ] keep
     swap change-size set-nth-pair ; inline
 
-: (each-pair) ( quot array i -- ) | quot ( k v -- )
+: (each-pair) ( quot array i -- )
     over array-capacity over eq? [
         3drop
     ] [
@@ -87,10 +87,10 @@ TUPLE: tombstone ;
         ] 3keep 2 fixnum+fast (each-pair)
     ] if ; inline
 
-: each-pair ( array quot -- ) | quot ( k v -- )
+: each-pair ( array quot -- )
     swap 0 (each-pair) ; inline
 
-: (all-pairs?) ( quot array i -- ? ) | quot ( k v -- ? )
+: (all-pairs?) ( quot array i -- ? )
     over array-capacity over eq? [
         3drop t
     ] [
@@ -105,7 +105,7 @@ TUPLE: tombstone ;
         ] if
     ] if ; inline
 
-: all-pairs? ( array quot -- ? ) | quot ( k v -- ? )
+: all-pairs? ( array quot -- ? )
     swap 0 (all-pairs?) ; inline
 
 : hash>seq ( i hash -- seq )
@@ -188,17 +188,17 @@ IN: hashtables
     [ length <hashtable> ] keep
     [ first2 swap pick (set-hash) ] each ;
 
-: hash-each ( hash quot -- ) | quot ( k v -- )
+: hash-each ( hash quot -- )
     >r hash-array r> each-pair ; inline
 
-: hash-each-with ( obj hash quot -- ) | quot ( obj k v -- )
+: hash-each-with ( obj hash quot -- )
     swap [ 2swap [ >r -rot r> call ] 2keep ] hash-each 2drop ;
     inline
 
-: hash-all? ( hash quot -- ) | quot ( k v -- ? )
+: hash-all? ( hash quot -- )
     >r hash-array r> all-pairs? ; inline
 
-: hash-all-with? ( obj hash quot -- ) | quot ( obj k v -- ? )
+: hash-all-with? ( obj hash quot -- )
     swap
     [ 2swap [ >r -rot r> call ] 2keep rot ] hash-all? 2nip ;
     inline
@@ -208,7 +208,7 @@ IN: hashtables
         >r swap hash* [ r> = ] [ r> 2drop f ] if
     ] hash-all-with? ;
 
-: hash-subset ( hash quot -- hash ) | quot ( k v -- ? )
+: hash-subset ( hash quot -- hash )
     over hash-size <hashtable> rot [
         2swap [
             >r pick pick >r >r call [
@@ -219,7 +219,7 @@ IN: hashtables
         ] 2keep
     ] hash-each nip ; inline
 
-: hash-subset-with ( obj hash quot -- hash ) | quot ( obj pair -- ?  )
+: hash-subset-with ( obj hash quot -- hash )
     swap
     [ 2swap [ >r -rot r> call ] 2keep rot ] hash-subset 2nip ;
     inline
@@ -292,14 +292,14 @@ IN: hashtables
 : remove-all ( hash seq -- seq )
     [ swap hash-member? not ] subset-with ;
 
-: cache ( key hash quot -- value ) | quot ( key -- value )
+: cache ( key hash quot -- value )
     pick pick hash [
         >r 3drop r>
     ] [
         pick rot >r >r call dup r> r> set-hash
     ] if* ; inline
 
-: map>hash ( seq quot -- hash ) | quot ( key -- key value )
+: map>hash ( seq quot -- hash )
     over length <hashtable> rot
     [ -rot [ >r call swap r> set-hash ] 2keep ] each nip ;
     inline

library/collections/sequence-combinators.factor

@@ -4,7 +4,7 @@ IN: sequences-internals
 USING: arrays generic kernel kernel-internals math sequences
 vectors ;
 
-: collect ( n quot -- array ) | quot ( n -- value )
+: collect ( n quot -- array )
     >r [ f <array> ] keep r> swap [
         [ rot >r [ swap call ] keep r> set-array-nth ] 3keep
     ] repeat drop ; inline
@@ -32,36 +32,36 @@ vectors ;
 
 IN: sequences
 
-: each ( seq quot -- ) | quot ( elt -- )
+: each ( seq quot -- )
     swap dup length [
         [ swap nth-unsafe swap call ] 3keep
     ] repeat 2drop ; inline
 
-: each-with ( obj seq quot -- ) | quot (  obj elt -- )
+: each-with ( obj seq quot -- )
     swap [ with ] each 2drop ; inline
 
-: reduce ( seq identity quot -- value ) | quot ( x y -- z )
+: reduce ( seq identity quot -- value )
     swapd each ; inline
 
-: map ( seq quot -- seq ) | quot ( elt -- elt )
+: map ( seq quot -- seq )
     over >r over length [ (map) ] collect r> like 2nip ;
     inline
 
-: map-with ( obj list quot -- list ) | quot ( obj elt -- elt )
+: map-with ( obj list quot -- list )
     swap [ with rot ] map 2nip ; inline
 
-: accumulate ( seq identity quot -- values ) | quot ( x y -- z )
+: accumulate ( seq identity quot -- values )
     rot [ pick >r swap call r> ] map-with nip ; inline
 
 : change-nth ( i seq quot -- )
     -rot [ nth swap call ] 2keep set-nth ; inline
 
-: inject ( seq quot -- ) | quot ( elt -- elt )
+: inject ( seq quot -- )
     over length
     [ [ -rot change-nth ] 3keep ] repeat 2drop ;
     inline
 
-: inject-with ( obj seq quot -- ) | quot ( obj elt -- elt )
+: inject-with ( obj seq quot -- )
     swap [ with rot ] inject 2drop ; inline
 
 : min-length ( seq seq -- n )
@@ -73,7 +73,7 @@ IN: sequences
 : 2each ( seq seq quot -- )
     -rot 2dup min-length [ (2each) ] repeat 3drop ; inline
 
-: 2reduce ( seq seq identity quot -- value ) | quot ( e x y -- z )
+: 2reduce ( seq seq identity quot -- value )
     >r -rot r> 2each ; inline
 
 : 2map ( seq seq quot -- seq )
@@ -93,13 +93,13 @@ IN: sequences
         ] if
     ] if-bounds ; inline
 
-: find-with* ( obj i seq quot -- i elt ) | quot ( elt -- ? )
+: find-with* ( obj i seq quot -- i elt )
     -rot [ with rot ] find* 2swap 2drop ; inline
 
-: find ( seq quot -- i elt ) | quot ( elt -- ? )
+: find ( seq quot -- i elt )
     0 -rot find* ; inline
 
-: find-with ( obj seq quot -- i elt ) | quot ( elt -- ? )
+: find-with ( obj seq quot -- i elt )
     swap [ with rot ] find 2swap 2drop ; inline
 
 : find-last* ( i seq quot -- i elt )
@@ -111,13 +111,13 @@ IN: sequences
         ] if
     ] if-bounds ; inline
 
-: find-last-with* ( obj i seq quot -- i elt ) | quot ( elt -- ? )
+: find-last-with* ( obj i seq quot -- i elt )
     -rot [ with rot ] find-last* 2swap 2drop ; inline
 
 : find-last ( seq quot -- i elt )
     >r [ length 1- ] keep r> find-last* ; inline
 
-: find-last-with ( obj seq quot -- i elt ) | quot ( elt -- ? )
+: find-last-with ( obj seq quot -- i elt )
     swap [ with rot ] find-last 2swap 2drop ; inline
 
 : contains? ( seq quot -- ? )
@@ -129,20 +129,20 @@ IN: sequences
 : all? ( seq quot -- ? )
     swap [ swap call not ] contains-with? not ; inline
 
-: all-with? ( obj seq quot -- ? ) | quot ( elt -- ? )
+: all-with? ( obj seq quot -- ? )
     swap [ with rot ] all? 2nip ; inline
 
-: subset ( seq quot -- seq ) | quot ( elt -- ? )
+: subset ( seq quot -- seq )
     over >r over length <vector> rot [
         -rot [
             >r over >r call [ r> r> push ] [ r> r> 2drop ] if
         ] 2keep
     ] each r> like nip ; inline
 
-: subset-with ( obj seq quot -- seq ) | quot ( obj elt -- ? )
+: subset-with ( obj seq quot -- seq )
     swap [ with rot ] subset 2nip ; inline
 
-: monotonic? ( seq quot -- ? ) | quot ( elt elt -- ? )
+: monotonic? ( seq quot -- ? )
     swap dup length 1- [
         pick pick >r >r (monotonic) r> r> rot
     ] all? 2nip ; inline
@@ -154,7 +154,7 @@ IN: sequences
         if
     ] 2each 2drop ; inline
 
-: cache-nth ( i seq quot -- elt ) | quot ( i -- elt )
+: cache-nth ( i seq quot -- elt )
     pick pick ?nth dup [
         >r 3drop r>
     ] [

library/collections/sequence-sort.factor

@@ -81,19 +81,19 @@ C: sorter ( seq start end -- sorter )
 
 IN: sequences
 
-: nsort ( seq quot -- | quot: elt elt -- -1/0/1 )
+: nsort ( seq quot -- )
     swap dup length 1 <=
     [ 2drop ] [ 0 over length 1- (nsort) ] if ; inline
 
-: sort ( seq quot -- seq | quot: elt elt -- -1/0/1 )
+: sort ( seq quot -- seq )
     swap [ swap nsort ] immutable ; inline
 
 : natural-sort ( seq -- seq ) [ <=> ] sort ;
 
-: binsearch ( elt seq quot -- i | quot: elt elt -- -1/0/1 )
+: binsearch ( elt seq quot -- i )
     swap dup empty?
     [ 3drop -1 ] [ flatten-slice (binsearch) ] if ; inline
 
-: binsearch* ( elt seq quot -- elt | quot: elt elt -- -1/0/1 )
+: binsearch* ( elt seq quot -- elt )
     over >r binsearch dup -1 = [ r> 2drop f ] [ r> nth ] if ;
     inline

library/collections/sequences-epilogue.factor

@@ -66,7 +66,7 @@ M: object like drop ;
 
 : >resizable ( seq -- seq ) [ thaw dup ] keep nappend ;
 
-: immutable ( seq quot -- seq | quot: seq -- )
+: immutable ( seq quot -- seq )
     swap [ >resizable [ swap call ] keep ] keep like ; inline
 
 : append ( s1 s2 -- s1+s2 )

library/collections/slicing.factor

@@ -97,11 +97,11 @@ strings vectors ;
 
 : split-next, V{ } clone , ;
 
-: (split) ( separator elt -- | separator: elt -- ? )
+: (split) ( separator elt -- )
     [ swap call ] keep swap
     [ drop split-next, ] [ split, ] if ; inline
 
-: split* ( seq separator -- split | separator: elt -- ? )
+: split* ( seq separator -- split )
     over >r
     [ split-next, swap [ (split) ] each-with ]
     { } make r> swap [ swap like ] map-with ; inline

library/compiler/alien/alien-invoke.factor

@@ -70,16 +70,15 @@ M: alien-invoke generate-node
 M: alien-invoke stack-reserve*
     alien-invoke-parameters stack-space ;
 
-: parse-arglist ( return seq -- types stack-effect )
+: parse-arglist ( return seq -- types effect )
     2 group unpair
-    rot dup "void" = [ drop { } ] [ 1array ] if 2array
-    effect>string ;
+    rot dup "void" = [ drop { } ] [ 1array ] if <effect> ;
 
 : (define-c-word) ( type lib func types stack-effect -- )
     >r over create-in dup reset-generic >r 
     [ alien-invoke ] curry curry curry curry
     r> swap define-compound word r>
-    "stack-effect" set-word-prop ;
+    "declared-effect" set-word-prop ;
 
 : define-c-word ( return library function parameters -- )
     [ "()" subseq? not ] subset >r pick r> parse-arglist

library/compiler/alien/compiler.factor

@@ -61,7 +61,7 @@ kernel-internals math namespaces sequences words ;
 : box-parameter ( stack# type -- node )
     c-type [ "reg-class" get "boxer" get call ] bind ;
 
-: if-void ( type true false -- | false: type -- )
+: if-void ( type true false -- )
     pick "void" = [ drop nip call ] [ nip call ] if ; inline
 
 : compile-gc ; ! "simple_gc" f %alien-invoke , ;

library/compiler/alien/malloc.factor

@@ -13,5 +13,5 @@ FUNCTION: void memcpy ( void* dst, void* src, ulong size ) ;
 TUPLE: check-ptr ;
 : check-ptr [ <check-ptr> throw ] unless* ;
 
-: with-malloc ( size quot -- | quot: alien -- )
+: with-malloc ( size quot -- )
     swap 1 calloc check-ptr [ swap call ] keep free ; inline

library/compiler/generator/generator.factor

@@ -36,7 +36,7 @@ UNION: #terminal
         dup #terminal-call? swap node-successor #terminal? or
     ] all? ;
 
-: generate-code ( node quot -- | quot: node -- )
+: generate-code ( node quot -- )
     over stack-reserve %prologue call ; inline
 
 : init-generator ( -- )
@@ -44,7 +44,7 @@ UNION: #terminal
     V{ } clone literal-table set
     V{ } clone label-table set ;
 
-: generate-1 ( word node quot -- ) | quot ( node -- )
+: generate-1 ( word node quot -- )
     #! Generate the code, then dump three vectors to pass to
     #! add-compiled-block.
     pick f save-xt [
@@ -99,10 +99,10 @@ M: #if generate-node
 : [with-template] ( quot template -- quot )
     2array >quotation [ with-template ] append ;
 
-: define-intrinsic ( word quot template -- ) | quot ( -- )
+: define-intrinsic ( word quot template -- )
     [with-template] "intrinsic" set-word-prop ;
 
-: define-if-intrinsic ( word quot template -- ) | quot ( label -- )
+: define-if-intrinsic ( word quot template -- )
     [with-template] "if-intrinsic" set-word-prop ;
 
 : if>boolean-intrinsic ( label -- )

library/compiler/inference/dataflow.factor

@@ -144,7 +144,7 @@ SYMBOL: current-node
 : #drop ( n -- #shuffle )
     d-tail in-node <#shuffle> ;
 
-: each-node ( node quot -- ) | quot ( node -- )
+: each-node ( node quot -- )
     over [
         [ call ] 2keep swap
         [ node-children [ swap each-node ] each-with ] 2keep
@@ -153,10 +153,10 @@ SYMBOL: current-node
         2drop
     ] if ; inline
 
-: each-node-with ( obj node quot -- ) | quot ( obj node -- )
+: each-node-with ( obj node quot -- )
     swap [ with ] each-node 2drop ; inline
 
-: all-nodes? ( node quot -- ? ) | quot ( node -- ? )
+: all-nodes? ( node quot -- ? )
     over [
         [ call ] 2keep rot [
             [
@@ -173,7 +173,7 @@ SYMBOL: current-node
         2drop t
     ] if ; inline
 
-: all-nodes-with? ( obj node quot -- ? ) | quot ( obj node -- ? )
+: all-nodes-with? ( obj node quot -- ? )
     swap [ with rot ] all-nodes? 2nip ; inline
 
 : remember-node ( word node -- )
@@ -237,20 +237,20 @@ DEFER: (map-nodes)
         drop
     ] if* ; inline
 
-: (map-nodes) ( prev quot -- ) | quot ( node -- node )
+: (map-nodes) ( prev quot -- )
     node@
     [ [ map-node ] keep map-next ]
     [ drop f swap ?set-node-successor ] if ; inline
 
-: map-first ( node quot -- node ) | quot ( node -- node )
+: map-first ( node quot -- node )
     call node> drop dup >node ; inline
 
-: map-nodes ( node quot -- node ) | quot ( node -- node )
+: map-nodes ( node quot -- node )
     over [
         over >node [ map-first ] keep map-next node>
     ] when drop ; inline
 
-: map-children ( quot -- ) | quot ( node -- node )
+: map-children ( quot -- )
     node@ [ node-children [ swap map-nodes ] map-with ] keep
     set-node-children ; inline
 

library/compiler/optimizer/kill-literals.factor

@@ -4,7 +4,7 @@ IN: optimizer
 USING: arrays generic hashtables inference kernel math
 namespaces sequences words ;
 
-: node-union ( node quot -- hash | quot: node -- )
+: node-union ( node quot -- hash )
     [
         swap [ swap call [ dup set ] each ] each-node-with
     ] make-hash ; inline

library/continuations.factor

@@ -33,7 +33,7 @@ TUPLE: continuation data retain call name catch ;
     [ continuation-name ] keep
     continuation-catch ; inline
 
-: ifcc ( terminator balance -- | quot: continuation -- )
+: ifcc ( terminator balance -- )
     [ f f continuation 2nip dup ] call 2swap if ; inline
 
 : callcc0 [ drop ] ifcc ; inline

library/effects.factor

@@ -0,0 +1,54 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: words
+USING: kernel math namespaces sequences strings generic ;
+
+TUPLE: effect in out terminated? ;
+
+C: effect
+    [
+        over { "*" } sequence=
+        [ nip t swap set-effect-terminated? ]
+        [ set-effect-out ] if
+    ] keep
+    [ set-effect-in ] keep ;
+
+: effect-height ( effect -- n )
+    dup effect-out length swap effect-in length - ;
+
+: effect<= ( eff1 eff2 -- ? )
+    2dup [ effect-terminated? ] 2apply = >r
+    2dup [ effect-in length ] 2apply <= >r
+    [ effect-height ] 2apply number= r> and r> and ;
+
+: stack-picture ( seq -- string )
+    [
+        [
+            {
+                { [ dup string? ] [ ] }
+                { [ dup word? ] [ word-name ] }
+                { [ dup integer? ] [ drop "object" ] }
+            } cond % CHAR: \s ,
+        ] each
+    ] "" make ;
+
+: effect>string ( effect -- string )
+    [
+        "( " %
+        dup effect-in stack-picture %
+        "-- " %
+        dup effect-out stack-picture %
+        effect-terminated? [ "* " % ] when
+        ")" %
+    ] "" make ;
+
+: stack-effect ( word -- string )
+    dup "declared-effect" word-prop [
+        effect>string
+    ] [
+        dup "infer-effect" word-prop [
+            effect>string
+        ] [
+            drop f
+        ] ?if
+    ] ?if ;

library/errors.factor

@@ -12,7 +12,7 @@ USING: kernel ;
 SYMBOL: error
 SYMBOL: error-continuation
 
-: catch ( try -- error | try: -- )
+: catch ( try -- error )
     [ >c call f c> drop f ] callcc1 nip ; inline
 
 : rethrow ( error -- )
@@ -23,12 +23,12 @@ SYMBOL: error-continuation
         c> dup quotation? [ call ] [ continue-with ] if
     ] if ;
 
-: cleanup ( try cleanup -- | try: -- | cleanup: -- )
+: cleanup ( try cleanup -- )
     [ >c >r call c> drop r> call ]
     [ drop (continue-with) >r nip call r> rethrow ] ifcc ;
     inline
 
-: recover ( try recovery -- | try: -- | recovery: error -- )
+: recover ( try recovery -- )
     [ >c drop call c> drop ]
     [ drop (continue-with) rot drop swap call ] ifcc ; inline
 

library/generic/classes.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: generic
 USING: arrays definitions errors hashtables kernel
-kernel-internals namespaces parser sequences strings words
+kernel-internals namespaces sequences strings words
 vectors math parser ;
 
 PREDICATE: word class "class" word-prop ;

library/generic/methods.factor

@@ -35,7 +35,7 @@ TUPLE: check-method class generic ;
     dup generic? [ <check-method> throw ] unless
     over class? [ <check-method> throw ] unless ;
 
-: with-methods ( word quot -- | quot: methods -- )
+: with-methods ( word quot -- )
     swap [ "methods" word-prop swap call ] keep ?make-generic ;
     inline
 

library/generic/tuple.factor

@@ -91,7 +91,7 @@ M: tuple equal?
 : delegates ( obj -- seq )
     [ (delegates) ] { } make ;
 
-: is? ( obj pred -- ? | pred: obj -- ? )
+: is? ( obj pred -- ? )
     >r delegates r> contains? ; inline
 
 : >tuple ( seq -- tuple )

library/help/help.factor

@@ -51,7 +51,7 @@ M: word article-content
         subsection-style [ first ($subsection) ] with-style
     ] ($block) ;
 
-: help-outliner ( seq  -- | quot: obj -- )
+: help-outliner ( seq  -- )
     subsection-style [
         sort-articles [ ($subsection) terpri ] each
     ] with-style ;

library/help/topics.factor

@@ -95,7 +95,7 @@ M: word-link where link-name "help-loc" word-prop ;
 M: word-link (synopsis)
     \ HELP: pprint-word
     link-name dup pprint-word
-    "stack-effect" word-prop pprint* ;
+    stack-effect comment. ;
 
 M: word-link definition
     link-name "help" word-prop t ;

library/io/string-streams.factor

@@ -22,7 +22,7 @@ M: sbuf stream-flush drop ;
         [ swap CHAR: \s pad-right ] map-with
     ] unless ;
 
-: map-last ( seq quot -- seq | quot: elt last? )
+: map-last ( seq quot -- seq )
     swap dup length <reversed>
     [ zero? rot [ call ] keep swap ] 2map nip ; inline
 

library/io/unix/sockets.factor

@@ -24,7 +24,7 @@ threads unix-internals ;
 : socket-fd ( -- socket )
     PF_INET SOCK_STREAM 0 socket dup io-error dup init-handle ;
 
-: with-socket-fd ( quot -- fd | quot: socket -- n )
+: with-socket-fd ( quot -- fd )
     socket-fd [ swap call ] keep  swap 0 < [
         err_no EINPROGRESS = [ dup close (io-error) ] unless
     ] when ; inline

library/math/math.factor

@@ -64,7 +64,7 @@ M: object zero? drop f ;
 
 : repeat 0 -rot (repeat) ; inline
 
-: times ( n quot -- ) | quot ( -- )
+: times ( n quot -- )
     swap [ >r dup slip r> ] repeat drop ; inline
 
 GENERIC: number>string ( n -- str ) foldable

library/syntax/early-parser.factor

@@ -50,22 +50,3 @@ C: parse-error ( error -- error )
     column get over set-parse-error-col
     line-text get over set-parse-error-text
     [ set-delegate ] keep ;
-
-TUPLE: effect in out declarations terminated? ;
-
-C: effect
-    [
-        over { "*" } sequence=
-        [ nip t swap set-effect-terminated? ]
-        [ set-effect-out ] if
-    ] keep
-    [ set-effect-in ] keep
-    H{ } clone over set-effect-declarations ;
-
-: effect-height ( effect -- n )
-    dup effect-out length swap effect-in length - ;
-
-: effect<= ( eff1 eff2 -- ? )
-    2dup [ effect-terminated? ] 2apply = >r
-    2dup [ effect-in length ] 2apply <= >r
-    [ effect-height ] 2apply number= r> and r> and ;

library/syntax/parse-syntax.factor

@@ -79,13 +79,4 @@ DEFER: !PRIMITIVE: parsing
     [ string-mode off [ (require) ] each ] f ; parsing
 
 : !(
-    word parse-effect dup 1array >vector effect-stack set
-    "declared-effect" set-word-prop ; parsing
-
-: !|
-    scan scan-word \ ( eq? [
-        parse-effect dup effect-stack get push
-        swap add-declaration
-    ] [
-        "Expected (" throw
-    ] if ; parsing
+    word parse-effect "declared-effect" set-word-prop ; parsing

library/syntax/parser.factor

@@ -4,7 +4,7 @@ IN: parser
 USING: arrays definitions errors generic hashtables kernel math
 namespaces prettyprint sequences strings vectors words ;
 
-: skip ( i seq quot -- n | quot: elt -- ? )
+: skip ( i seq quot -- n )
     over >r find* drop dup -1 =
     [ drop r> length ] [ r> drop ] if ; inline
 
@@ -90,8 +90,6 @@ TUPLE: bad-escape ;
     column
     [ [ line-text get (parse-string) ] "" make swap ] change ;
 
-SYMBOL: effect-stack
-
 : (parse-effect) ( -- )
     scan [
         dup ")" = [ drop ] [ , (parse-effect) ] if
@@ -103,11 +101,6 @@ SYMBOL: effect-stack
     [ (parse-effect) column get ] { } make swap column set
     { "--" } split1 <effect> ;
 
-: add-declaration ( effect name -- )
-    effect-stack get [
-        2dup effect-in member? >r dupd effect-out member? r> or
-    ] find nip effect-declarations set-hash ;
-
 global [
     {
         "scratchpad" "syntax" "arrays" "compiler" "definitions"

library/test/parser.factor

@@ -60,21 +60,9 @@ unit-test
 
 : foo ( a b -- c ) + ;
 
-[ T{ effect f { "a" "b" } { "c" } H{ } f } ]
+[ T{ effect f { "a" "b" } { "c" } f } ]
 [ \ foo "declared-effect" word-prop ] unit-test
 
-: bar ( a quot -- b ) | quot ( u -- v ) call ;
-
-[
-    T{ effect f
-        { "a" "quot" }
-        { "b" }
-        H{ { "quot" T{ effect f { "u" } { "v" } H{ } } } }
-        f
-    }
-]
-[ \ bar "declared-effect" word-prop ] unit-test
-
 [ t ] [ 1 1 <effect> 2 2 <effect> effect<= ] unit-test
 [ f ] [ 1 0 <effect> 2 2 <effect> effect<= ] unit-test
 [ t ] [ 2 2 <effect> 2 2 <effect> effect<= ] unit-test

library/test/prettyprint.factor

@@ -39,7 +39,8 @@ unit-test
 
 : bar ( x -- y ) 2 + ;
 
-[ "IN: temporary : bar 2 + ;\n" ] [ [ \ bar see ] string-out ] unit-test
+[ "IN: temporary : bar ( x -- y ) 2 + ;\n" ]
+[ [ \ bar see ] string-out ] unit-test
 
 [ "( a b -- c d )" ] [
     { { "a" "b" } { "c" "d" } } effect>string

library/tools/definitions.factor

@@ -20,21 +20,20 @@ GENERIC: (synopsis) ( spec -- )
         H{ } <block \ IN: pprint-word write-vocab block;
     ] when* ;
 
+: comment. ( comment -- )
+    [ H{ { font-style italic } } styled-text ] when* ;
+
 M: word (synopsis)
-    dup in. dup definer pprint-word pprint-word ;
+    dup in.
+    dup definer pprint-word
+    dup pprint-word
+    stack-effect comment. ;
 
 M: method-spec (synopsis)
     \ M: pprint-word [ pprint-word ] each ;
 
-: comment. ( comment -- )
-    [ H{ { font-style italic } } [ text ] with-style ] when* ;
-
 : synopsis ( word -- string )
-    [
-        0 margin set [
-            dup (synopsis) stack-effect comment.
-        ] with-pprint
-    ] string-out ;
+    [ 0 margin set [ (synopsis) ] with-pprint ] string-out ;
 
 GENERIC: definition ( spec -- quot ? )
 

library/tools/jedit.factor

@@ -68,11 +68,11 @@ namespaces parser prettyprint sequences strings words shells ;
             dup definer ,
             dup word-vocabulary ,
             dup word-name ,
-            "stack-effect" word-prop ,
+            stack-effect ,
         ] [ ] make
     ] when ;
 
-: completions ( str pred -- list | pred: str word -- ? )
+: completions ( str pred -- seq )
     #! Make a list of completions. Each element of the list is
     #! a vocabulary/name/stack-effect triplet list.
     word-subset-with [ jedit-lookup ] map ;

library/tools/word-tools.factor

@@ -13,7 +13,7 @@ math namespaces prettyprint sequences strings styles ;
 : usage. ( word -- )
     usage [ usage. ] word-outliner ;
 
-: annotate ( word quot -- | quot: word def -- def )
+: annotate ( word quot -- )
     over >r >r dup word-def r> call r> swap define-compound ;
     inline
 

library/ui/cocoa/callback.factor

@@ -27,6 +27,6 @@ reset-callbacks
     }
 } { } define-objc-class
 
-: <FactorCallback> ( quot -- id | quot: id -- )
+: <FactorCallback> ( quot -- id )
     FactorCallback -> alloc -> init
     [ callbacks get set-hash ] keep ;

library/ui/cocoa/services.factor

@@ -18,7 +18,7 @@ parser prettyprint styles ;
         nip pasteboard-error
     ] if ;
 
-: do-service ( pboard error quot -- | quot: str -- str/f )
+: do-service ( pboard error quot -- )
     pick >r >r
     ?pasteboard-string dup [ r> call ] [ r> 2drop f ] if
     dup [ r> set-pasteboard-string ] [ r> 2drop ] if ;

library/ui/gadgets/grids.factor

@@ -31,7 +31,7 @@ C: grid ( children -- grid )
     pref-dim-grid
     dup flip [ max-dim ] map swap [ max-dim ] map ;
 
-: with-grid ( grid quot -- | quot: horiz vert -- )
+: with-grid ( grid quot -- )
     [ >r grid set compute-grid r> call ] with-scope ; inline
 
 : gap grid get grid-gap ;

library/ui/gadgets/paragraphs.factor

@@ -42,7 +42,7 @@ SYMBOL: margin
     dup line-height [ max ] change
     y get + max-y [ max ] change ;
 
-: wrap-step ( quot child -- | quot: pos child -- )
+: wrap-step ( quot child -- )
     dup pref-dim [
         over word-break-gadget? [
             dup first overrun? [ wrap-line ] when
@@ -55,7 +55,7 @@ SYMBOL: margin
     paragraph-margin margin set
     0 { x max-x y max-y line-height } [ set ] each-with ;
 
-: do-wrap ( paragraph quot -- dim | quot: pos child -- )
+: do-wrap ( paragraph quot -- dim )
     [
         swap dup init-wrap
         [ wrap-step ] each-child-with wrap-dim

library/ui/gadgets/tiles.factor

@@ -8,7 +8,7 @@ TUPLE: tile gadget ;
 
 : find-tile [ tile? ] find-parent ;
 
-: <close-button> ( quot -- gadget | quot: tile -- )
+: <close-button> ( quot -- gadget )
     { 0.0 0.0 0.0 1.0 } close-box <polygon-gadget>
     [ find-tile ] rot append <bevel-button> ;
 
@@ -18,7 +18,7 @@ TUPLE: tile gadget ;
         { [ <label> ]        f f @center }
     } make-frame ;
 
-: <title> ( title quot -- gadget | quot: tile -- )
+: <title> ( title quot -- gadget )
     [ <closable-title> ] [ <label> ] if* dup title-theme ;
 
 C: tile ( gadget title quot -- gadget )

library/ui/text/commands.factor

@@ -23,7 +23,7 @@ sequences ;
 : editor-cut ( editor clipboard -- )
     dupd editor-copy remove-editor-selection ;
 
-: delete/backspace ( elt editor quot -- | quot: caret editor -- from to )
+: delete/backspace ( elt editor quot -- )
     over gadget-selection? [
         drop nip remove-editor-selection
     ] [

library/ui/text/editor.factor

@@ -52,7 +52,7 @@ M: editor model-changed
 
 : editor-mark* editor-mark model-value ;
 
-: change-caret ( editor quot -- | quot: caret doc -- caret )
+: change-caret ( editor quot -- )
     over >r >r dup editor-caret* swap control-model r> call r>
     [ control-model validate-loc ] keep
     editor-caret set-model ; inline

library/words.factor

@@ -142,14 +142,14 @@ SYMBOL: bootstrapping?
 
 : ensure-vocab ( name -- ) vocabularies get [ nest drop ] bind ;
 
-: words ( vocab -- list ) vocab dup [ hash-values ] when ;
+: words ( vocab -- seq ) vocab dup [ hash-values ] when ;
 
-: all-words ( -- list ) vocabs [ words ] map concat ;
+: all-words ( -- seq ) vocabs [ words ] map concat ;
 
-: word-subset ( pred -- list )
+: word-subset ( pred -- seq )
     all-words swap subset ; inline
 
-: word-subset-with ( obj pred -- list | pred: obj word -- ? )
+: word-subset-with ( obj pred -- seq )
     all-words swap subset-with ; inline
 
 : xref-words ( -- )
@@ -183,21 +183,6 @@ TUPLE: check-create name vocab ;
         ] when lookup
     ] when ;
 
-: stack-picture ( seq -- string )
-    [ [ % CHAR: \s , ] each ] "" make ;
-
-: effect>string ( effect -- string )
-    [
-        "( " %
-        dup first stack-picture %
-        "-- " %
-        second stack-picture %
-        ")" %
-    ] "" make ;
-
-: stack-effect ( word -- string )
-    "stack-effect" word-prop ;
-
 ! Definition protocol
 M: word where "loc" word-prop ;