inlining method body if type of object passed to generic is known

TODO.FACTOR.txt

@@ -7,7 +7,6 @@
 - type inference fails with some assembler words;
   displaced, register and other predicates need to inherit from list
   not cons, and need stronger branch partial eval
-- optimize away dispatch
 - code gc
 - don't hardcode so many colors
 - ffi unicode strings: null char security hole
@@ -15,6 +14,7 @@
 - more accurate types for various words
 - declarations
 - write read: write should flush
+- optimize away arithmetic dispatch
 
 + compiler/ffi:
 

library/combinators.factor

@@ -21,9 +21,18 @@ IN: kernel
     #! restore a and b after the quotation returns.
     over >r pick >r call r> r> ; inline
 
-: apply ( code input -- code output )
-    #! Apply code to input.
-    swap dup >r call r> swap ; inline
+: while ( quot generator -- )
+    #! Keep applying the quotation to the value produced by
+    #! calling the generator until the generator returns f.
+    2dup >r >r swap >r call dup [
+        r> call r> r> while
+    ] [
+        r> 2drop r> r> 2drop
+    ] ifte ; inline
+
+: apply ( code input -- code )
+    #! A utility word for recursive combinators.
+    swap dup slip ; inline
 
 : ifte* ( cond true false -- )
     #! If the condition is not f, execute the 'true' quotation,

library/cons.factor

@@ -11,19 +11,19 @@ BUILTIN: cons 2 [ 0 "car" f ] [ 1 "cdr" f ] ;
 : swons ( cdr car -- [[ car cdr ]] )
     #! Push a new cons cell. If the cdr is f or a proper list,
     #! has the effect of prepending the car to the cdr.
-    swap cons ; inline
+    swap cons ;
 
 : uncons ( [[ car cdr ]] -- car cdr )
     #! Push both the head and tail of a list.
-    dup car swap cdr ; inline
+    dup car swap cdr ;
 
 : unit ( a -- [ a ] )
     #! Construct a proper list of one element.
-    f cons ; inline
+    f cons ;
 
 : unswons ( [[ car cdr ]] -- cdr car )
     #! Push both the head and tail of a list.
-    dup cdr swap car ; inline
+    dup cdr swap car ;
 
 : 2car ( cons cons -- car car )
     swap car swap car ;

library/errors.factor

@@ -1,12 +1,16 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: kernel DEFER: callcc1
-IN: errors USING: kernel-internals lists namespaces ;
+IN: streams DEFER: line-number
+IN: parser DEFER: file
+IN: errors USING: kernel-internals lists namespaces streams ;
+
+TUPLE: undefined-method object generic ;
 
 : undefined-method ( object generic -- )
-    #! This word is redefined in tools/debugger.factor with a
-    #! more useful definition once unparse is available.
-    "No suitable method" throw ;
+    #! We 2dup here to leave both values on the stack, for
+    #! post-mortem inspection.
+    2dup <undefined-method> throw ;
 
 ! This is a very lightweight exception handling system.
 
@@ -22,8 +26,8 @@ IN: errors USING: kernel-internals lists namespaces ;
     namespace [
         "col" get
         "line" get
-        "line-number" get
-        "file" get
+        line-number get
+        file get
         global [
             "error-file" set
             "error-line-number" set

library/generic/generic.factor

@@ -92,11 +92,17 @@ namespaces parser strings words vectors math math-internals ;
 : single-combination ( obj vtable -- )
     >r dup type r> dispatch ; inline
 
+PREDICATE: compound generic ( word -- ? )
+    "combination" word-property [ single-combination ] = ;
+
 : arithmetic-combination ( n n vtable -- )
     #! Note that the numbers remain on the stack, possibly after
     #! being coerced to a maximal type.
     >r arithmetic-type r> dispatch ; inline
 
+PREDICATE: compound 2generic ( word -- ? )
+    "combination" word-property [ arithmetic-combination ] = ;
+
 ! Maps lists of builtin type numbers to class objects.
 SYMBOL: classes
 

library/hashtables.factor

@@ -44,7 +44,7 @@ IN: hashtables
     dup hash-size 1 - swap set-hash-size ;
 
 : bucket-count ( hash -- n )
-    hash-array array-capacity ; inline
+    hash-array array-capacity ;
 
 : (hashcode) ( key table -- index )
     #! Compute the index of the bucket for a key.

library/inference/branches.factor

@@ -150,6 +150,23 @@ SYMBOL: cloned
     r> swap #label dataflow, [ node-label set ] extend >r
     meta-r set meta-d set d-in set r> ;
 
+: with-block ( word [[ label quot ]] quot -- node )
+    #! Execute a quotation with the word on the stack, and add
+    #! its dataflow contribution to a new block node in the IR.
+    over [
+        >r
+        dupd cons
+        recursive-state cons@
+        r> call
+    ] (with-block) ;
+
+: infer-quot-value ( value -- )
+    gensym dup pick literal-value cons [
+        drop
+        dup value-recursion recursive-state set
+        literal-value dup infer-quot
+    ] with-block drop handle-terminator ;
+
 : boolean-value? ( value -- ? )
     #! Return if the value's boolean valuation is known.
     value-class
@@ -170,10 +187,7 @@ SYMBOL: cloned
     #! If the branch taken is statically known, just infer
     #! along that branch.
     dataflow-drop, pop-d boolean-value [ drop ] [ nip ] ifte
-    gensym [
-        dup value-recursion recursive-state set
-        literal-value infer-quot
-    ] (with-block) drop ;
+    infer-quot-value ;
 
 : dynamic-ifte ( true false -- )
     #! If branch taken is computed, infer along both paths and
@@ -207,16 +221,32 @@ SYMBOL: cloned
     0 recursive-state get <literal>
     [ set-value-literal-ties ] keep ;
 
+: static-dispatch? ( -- )
+    peek-d literal? branches-can-fail? not and ;
+
 USE: kernel-internals
-: infer-dispatch ( -- )
-    #! Infer effects for all branches, unify.
-    [ object vector ] ensure-d
-    dataflow-drop, pop-d vtable>list
+
+: static-dispatch ( vtable -- )
+    >r dataflow-drop, pop-d literal-value r>
+    dup literal-value swap value-recursion
+    >r vector-nth r> <literal> infer-quot-value ;
+
+: dynamic-dispatch ( vtable -- )
     >r 1 meta-d get vector-tail* \ dispatch r>
+    vtable>list 
     pop-d <dispatch-index>
     over length [ <literal-tie> ] project-with
     zip infer-branches ;
 
+: infer-dispatch ( -- )
+    #! Infer effects for all branches, unify.
+    [ object vector ] ensure-d
+    dataflow-drop, pop-d  static-dispatch? [
+        static-dispatch
+    ] [
+        dynamic-dispatch
+    ] ifte ;
+
 \ dispatch [ infer-dispatch ] "infer" set-word-property
 \ dispatch [ [ fixnum vector ] [ ] ]
 "infer-effect" set-word-property

library/inference/conditions.factor

@@ -27,7 +27,11 @@ M: inference-error error. ( error -- )
     "Inference error: " inference-condition. ;
 
 : inference-warning ( msg -- )
-    \ inference-warning inference-condition error. ;
+    "inference-warnings" get [
+        \ inference-warning inference-condition error.
+    ] [
+        drop
+    ] ifte ;
 
 PREDICATE: cons inference-warning car \ inference-warning = ;
 M: inference-warning error. ( error -- )

library/inference/inference.factor

@@ -121,9 +121,6 @@ M: computed literal-value ( value -- )
     #! After inference is finished, collect information.
     uncons vector-length >r vector-length r> cons ;
 
-: effect ( -- [[ d-in meta-d ]] )
-    d-in get meta-d get cons ;
-
 : init-inference ( recursive-state -- )
     init-interpreter
     0 <vector> d-in set
@@ -131,7 +128,7 @@ M: computed literal-value ( value -- )
     dataflow-graph off
     0 inferring-base-case set ;
 
-DEFER: apply-word
+GENERIC: apply-object
 
 : apply-literal ( obj -- )
     #! Literals are annotated with the current recursive
@@ -139,14 +136,20 @@ DEFER: apply-word
     dup recursive-state get <literal> push-d
     #push dataflow, [ 1 0 node-outputs ] bind ;
 
-: apply-object ( obj -- )
-    #! Apply the object's stack effect to the inferencer state.
-    dup word? [ apply-word ] [ apply-literal ] ifte ;
+M: object apply-object apply-literal ;
 
 : active? ( -- ? )
     #! Is this branch not terminated?
     d-in get meta-d get and ;
 
+: check-active ( -- )
+    active? [
+         "Provable runtime error" inference-error
+    ] unless ;
+
+: effect ( -- [[ d-in meta-d ]] )
+    d-in get meta-d get cons ;
+
 : terminate ( -- )
     #! Ignore this branch's stack effect.
     meta-d off meta-r off d-in off ;
@@ -184,6 +187,7 @@ DEFER: apply-word
 : (infer) ( quot -- )
     f init-inference
     infer-quot
+    check-active
     #return values-node check-return ;
 
 : infer ( quot -- [[ in out ]] )

library/inference/types.factor

@@ -17,6 +17,7 @@ lists math namespaces strings vectors words stdio prettyprint ;
     \ slot [ [ object ] [ object ] ] (consume/produce) ;
 
 : computed-slot ( -- )
+    "Computed slot access is slower" inference-warning
     \ slot dup "infer-effect" word-property consume/produce ;
 
 \ slot [
@@ -29,8 +30,11 @@ lists math namespaces strings vectors words stdio prettyprint ;
     [ tuck builtin-type <class-tie> cons ] project-with
     [ cdr class-tie-class ] subset ;
 
-\ type [
-    [ object ] ensure-d
+: literal-type ( -- )
+    dataflow-drop, pop-d value-class builtin-supertypes car
+    apply-literal ;
+
+: computed-type ( -- )
     \ type #call dataflow, [
         peek-d type-value-map >r
         1 0 node-inputs
@@ -38,5 +42,9 @@ lists math namespaces strings vectors words stdio prettyprint ;
         [ fixnum ] produce-d
         r> peek-d set-value-literal-ties
         1 0 node-outputs
-    ] bind
+    ] bind ;
+
+\ type [
+    [ object ] ensure-d
+    literal-type? [ literal-type ] [ computed-type ] ifte
 ] "infer" set-word-property

library/inference/words.factor

@@ -29,30 +29,9 @@ strings vectors words hashtables parser prettyprint ;
     #! produces a number of values.
     #call swap (consume/produce) ;
 
-: apply-effect ( word [ in-types out-types ] -- )
-    #! If a word does not have special inference behavior, we
-    #! either execute the word in the meta interpreter (if it is
-    #! side-effect-free and all parameters are literal), or
-    #! simply apply its stack effect to the meta-interpreter.
-    over "infer" word-property [
-        swap car ensure-d call drop
-    ] [
-        consume/produce
-    ] ifte* ;
-
 : no-effect ( word -- )
     "Unknown stack effect: " swap word-name cat2 inference-error ;
 
-: with-block ( word [[ label quot ]] quot -- node )
-    #! Execute a quotation with the word on the stack, and add
-    #! its dataflow contribution to a new block node in the IR.
-    over [
-        >r
-        dupd cons
-        recursive-state cons@
-        r> call
-    ] (with-block) ;
-
 : recursive? ( word -- ? )
     dup word-parameter tree-contains? ;
 
@@ -94,19 +73,53 @@ M: compound (apply-word) ( word -- )
     dup "no-effect" word-property [
         no-effect
     ] [
-        dup "inline" word-property [
-            inline-compound 2drop
-        ] [
-            infer-compound
-        ] ifte
+        infer-compound
     ] ifte ;
 
-M: promise (apply-word) ( word -- )
-    "promise" word-property unit ensure-d ;
-
 M: symbol (apply-word) ( word -- )
     apply-literal ;
 
+GENERIC: apply-word
+
+: apply-default ( word -- )
+    dup "infer-effect" word-property [
+        over "infer" word-property [
+            swap car ensure-d call drop
+        ] [
+            consume/produce
+        ] ifte*
+    ] [
+        (apply-word)
+    ] ifte* ;
+
+M: word apply-word ( word -- )
+    apply-default ;
+
+M: compound apply-word ( word -- )
+    dup "inline" word-property [
+        inline-compound 2drop
+    ] [
+        apply-default
+    ] ifte ;
+
+: literal-type? ( -- ? )
+    peek-d value-class builtin-supertypes
+    dup length 1 = >r [ tuple ] = not r> and ;
+
+: dynamic-dispatch-warning ( word -- )
+    "Dynamic dispatch for " swap word-name cat2
+    inference-warning ;
+
+M: generic apply-word ( word -- )
+    #! If the type of the value at the top of the stack is
+    #! known, inline the method body.
+    [ object ] ensure-d
+    literal-type? branches-can-fail? not and [
+        inline-compound 2drop
+    ] [
+        dup dynamic-dispatch-warning apply-default
+    ] ifte ;
+
 : with-recursion ( quot -- )
     [
         inferring-base-case inc
@@ -143,32 +156,24 @@ M: symbol (apply-word) ( word -- )
         ] ifte
     ] ifte ;
 
-: apply-word ( word -- )
+M: word apply-object ( word -- )
     #! Apply the word's stack effect to the inferencer state.
     dup recursive-state get assoc [
         recursive-word
     ] [
-        dup "infer-effect" word-property [
-            apply-effect
-        ] [
-            (apply-word)
-        ] ifte*
+        apply-word
     ] ifte* ;
 
 : infer-call ( -- )
     [ general-list ] ensure-d
-    dataflow-drop,
-    pop-d gensym dup pick literal-value cons [
-        drop
-        dup value-recursion recursive-state set
-        literal-value dup infer-quot
-    ] with-block drop handle-terminator ;
+    dataflow-drop, pop-d infer-quot-value ;
 
 \ call [ infer-call ] "infer" set-word-property
 
 ! These hacks will go away soon
 \ * [ [ number number ] [ number ] ] "infer-effect" set-word-property
 \ - [ [ number number ] [ number ] ] "infer-effect" set-word-property
+\ + [ [ number number ] [ number ] ] "infer-effect" set-word-property
 \ = [ [ object object ] [ object ] ] "infer-effect" set-word-property
 
 \ undefined-method t "terminator" set-word-property

library/io/stream.factor

@@ -3,7 +3,7 @@
 IN: stdio
 DEFER: stdio
 IN: streams
-USING: errors kernel namespaces strings generic lists ;
+USING: errors generic kernel lists math namespaces strings ;
 
 GENERIC: stream-flush      ( stream -- )
 GENERIC: stream-auto-flush ( stream -- )
@@ -53,3 +53,19 @@ C: wrapper-stream ( stream -- stream )
         >r <namespace> [ stdio set ] extend r>
         set-wrapper-stream-scope
     ] keep ;
+
+SYMBOL: line-number
+SYMBOL: parser-stream
+
+: next-line ( -- str )
+    parser-stream get stream-readln
+    line-number [ 1 + ] change ;
+
+: read-lines ( stream quot -- )
+    #! Apply a quotation to each line as its read. Close the
+    #! stream.
+    swap [
+        parser-stream set 0 line-number set [ next-line ] while
+    ] [
+        parser-stream get stream-close rethrow
+    ] catch ;

library/math/complex.factor

@@ -9,7 +9,7 @@ USING: generic kernel kernel-internals math ;
 : (rect>) ( xr xi -- x )
     #! Does not perform a check that the arguments are reals.
     #! Do not use in your own code.
-    dup 0 number= [ drop ] [ <complex> ] ifte ; inline
+    dup 0 number= [ drop ] [ <complex> ] ifte ;
 
 IN: math
 
@@ -28,7 +28,7 @@ M: number = ( n n -- ? ) number= ;
         "Complex number must have real components" throw drop
     ] ifte ;
 
-: >rect ( x -- xr xi ) dup real swap imaginary ; inline
+: >rect ( x -- xr xi ) dup real swap imaginary ;
 
 : conjugate ( z -- z* )
     >rect neg rect> ;
@@ -65,8 +65,8 @@ IN: math-internals
 M: complex number= ( x y -- ? )
     2>rect number= [ number= ] [ 2drop f ] ifte ;
 
-: *re ( x y -- xr*yr xi*ri ) 2>rect * >r * r> ; inline
-: *im ( x y -- xi*yr xr*yi ) 2>rect >r * swap r> * ; inline
+: *re ( x y -- xr*yr xi*ri ) 2>rect * >r * r> ;
+: *im ( x y -- xi*yr xr*yi ) 2>rect >r * swap r> * ;
 
 M: complex + 2>rect + >r + r> (rect>) ;
 M: complex - 2>rect - >r - r> (rect>) ;
@@ -74,7 +74,7 @@ M: complex * ( x y -- x*y ) 2dup *re - -rot *im + (rect>) ;
 
 : complex/ ( x y -- r i m )
     #! r = xr*yr+xi*yi, i = xi*yr-xr*yi, m = yr*yr+yi*yi
-    dup absq >r 2dup *re + -rot *im - r> ; inline
+    dup absq >r 2dup *re + -rot *im - r> ;
 
 M: complex / ( x y -- x/y ) complex/ tuck / >r / r> (rect>) ;
 M: complex /f ( x y -- x/y ) complex/ tuck /f >r /f r> (rect>) ;

library/math/integer.factor

@@ -13,7 +13,7 @@ USING: errors generic kernel math ;
         drop
     ] [
         (fraction>)
-    ] ifte ; inline
+    ] ifte ;
 
 : division-by-zero ( x y -- )
     "Division by zero" throw drop ;

library/math/math.factor

@@ -40,10 +40,10 @@ GENERIC: bitnot ( n -- n )
     #! by swapping them.
     2dup > [ swap ] when  >r dupd max r> min = ;
 
-: sq dup * ; inline
+: sq dup * ;
 
-: neg 0 swap - ; inline
-: recip 1 swap / ; inline
+: neg 0 swap - ;
+: recip 1 swap / ;
 
 : rem ( x y -- x%y )
     #! Like modulus, but always gives a positive result.

library/namespaces.factor

@@ -30,7 +30,7 @@ strings vectors ;
 
 : namespace ( -- namespace )
     #! Push the current namespace.
-    namestack car ; inline
+    namestack car ;
 
 : >n ( namespace -- n:namespace )
     #! Push a namespace on the namespace stack.

library/sbuf.factor

@@ -19,7 +19,7 @@ IN: strings USING: kernel lists math namespaces strings ;
     #! push a new string constructed from return values.
     #! The quotation must have stack effect ( X -- X ).
     over str-length <sbuf> rot [
-        swap >r apply r> tuck sbuf-append
+        swap >r apply swap r> tuck sbuf-append
     ] str-each nip sbuf>str ; inline
 
 : split-next ( index string split -- next )

library/syntax/parse-stream.factor

@@ -36,29 +36,7 @@ USE: streams
 USE: strings
 
 ! Stream parsing uses a number of variables:
-! file
-! line-number
-! parse-stream
-
-: next-line ( -- str )
-    "parse-stream" get stream-readln
-    "line-number" [ 1 + ] change ;
-
-: (read-lines) ( quot -- )
-    next-line dup [
-        swap dup >r call r> (read-lines)
-    ] [
-        2drop
-    ] ifte ;
-
-: read-lines ( stream quot -- )
-    #! Apply a quotation to each line as its read. Close the
-    #! stream.
-    swap [
-        "parse-stream" set 0 "line-number" set (read-lines)
-    ] [
-        "parse-stream" get stream-close rethrow
-    ] catch ;
+SYMBOL: file
 
 : file-vocabs ( -- )
     "file-in" get "in" set
@@ -66,10 +44,10 @@ USE: strings
 
 : (parse-stream) ( name stream -- quot )
     #! Uses the current namespace for temporary variables.
-    >r "file" set f ( initial parse tree ) r>
+    >r file set f ( initial parse tree ) r>
     [ (parse) ] read-lines reverse
-    "file" off
-    "line-number" off ;
+    file off
+    line-number off ;
 
 : parse-stream ( name stream -- quot )
     [ file-vocabs (parse-stream) ] with-scope ;

library/syntax/parser.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: parser
-USING: errors kernel lists math namespaces strings words
+USING: errors kernel lists math namespaces streams strings words
 unparser ;
 
 ! The parser uses a number of variables:
@@ -109,9 +109,9 @@ global [ string-mode off ] bind
 : save-location ( word -- )
     #! Remember where this word was defined.
     dup set-word
-    dup "line-number" get "line" set-word-property
+    dup line-number get "line" set-word-property
     dup "col" get "col"  set-word-property
-    "file" get "file" set-word-property ;
+    file get "file" set-word-property ;
 
 : create-in "in" get create ;
 

library/syntax/see.factor

@@ -107,13 +107,19 @@ M: compound see ( word -- )
     prettyprint-;
     terpri ;
 
-M: generic see ( word -- )
-    dup prettyprint-IN:
+: see-generic ( word definer -- )
+    >r dup prettyprint-IN:
     0 swap
-    dup "definer" word-property prettyprint-word " " write
+    r> prettyprint-word " " write
     dup prettyprint-word terpri
     dup methods [ over >r uncons see-method r> ] each 2drop ;
 
+M: generic see ( word -- )
+    \ GENERIC: see-generic ;
+
+M: 2generic see ( word -- )
+    \ 2GENERIC: see-generic ;
+
 M: primitive see ( word -- )
     dup prettyprint-IN:
     "PRIMITIVE: " write dup prettyprint-word stack-effect.

library/test/benchmark/fib.factor

@@ -16,7 +16,7 @@ USE: math-internals
 [ 9227465 ] [ 34 fixnum-fib ] unit-test
 
 : fib ( n -- nth fibonacci number )
-    dup 1 <= [ drop 1 ] [ 1 - dup fib swap 1 - fib + ] ifte ;
+    dup 1 <= [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] ifte ;
     compiled
 
 [ 9227465 ] [ 34 fib ] unit-test

library/test/inference.factor

@@ -219,6 +219,14 @@ SYMBOL: sym-test
 [ [ [ object ] [ general-t ] ] ] [ [ dup [ drop t ] unless ] infer ] unit-test
 [ [ [ cons ] [ cons ] ] ] [ [ uncons cons ] infer ] unit-test
 [ [ [ general-list ] [ object ] ] ] [ [ dup [ car ] when ] infer ] unit-test
+
+[ [ 5 car ] infer ] unit-test-fails
+
+GENERIC: potential-hang
+M: fixnum potential-hang dup [ potential-hang ] when ;
+
+[ ] [ [ 5 potential-hang ] infer drop ] unit-test
+
 ! [ [ [ number ] [ number ] ] ] [ [ dup + ] infer ] unit-test
 ! [ [ [ number number number ] [ number ] ] ] [ [ digit+ ] infer ] unit-test
 ! [ [ [ number ] [ real real ] ] ] [ [ >rect ] infer ] unit-test

library/tools/debugger.factor

@@ -141,15 +141,13 @@ M: object error. ( error -- )
     [ dup save-error rethrow ] 5 setenv ( kernel calls on error )
     kernel-error 12 setenv ;
 
-: undefined-method ( object generic -- )
-    #! We 2dup here to leave both values on the stack, for
-    #! post-mortem inspection.
-    2dup [
+M: undefined-method error. ( error -- )
+    [
         "The generic word " ,
-        unparse ,
+        dup undefined-method-generic unparse ,
         " does not have a suitable method for " ,
-        unparse ,
-    ] make-string throw ;
+        undefined-method-object unparse ,
+    ] make-string print ;
 
 ! So that stage 2 boot gives a useful error message if something
 ! fails after this file is loaded.

library/tools/memory.factor

@@ -21,17 +21,11 @@ namespaces prettyprint stdio unparser vectors words ;
 
 ! Some words for iterating through the heap.
 
-: (each-object) ( quot -- )
-    next-object dup [
-        swap dup slip (each-object)
-    ] [
-        2drop
-    ] ifte ;
-
 : each-object ( quot -- )
     #! Applies the quotation to each object in the image.
     [
-        begin-scan (each-object)
+        begin-scan
+        [ next-object ] while
     ] [
         end-scan rethrow
     ] catch ;

library/tools/word-tools.factor

@@ -13,9 +13,15 @@ M: compound word-uses? ( of in -- ? )
     ] [
         word-parameter tree-contains?
     ] ifte ;
-M: generic word-uses? ( of in -- ? )
+
+: generic-uses? ( of in -- ? )
     "methods" word-property hash>alist tree-contains? ;
 
+M: generic word-uses? ( of in -- ? )
+    generic-uses? ;
+M: 2generic word-uses? ( of in -- ? )
+    generic-uses? ;
+
 : usages-in-vocab ( of vocab -- usages )
     #! Push a list of all usages of a word in a vocabulary.
     words [

library/vectors.factor

@@ -27,7 +27,7 @@ IN: kernel-internals
 : grow-capacity ( len vec -- )
     #! If the vector cannot accomodate len elements, resize it
     #! to exactly len.
-    [ vector-array grow-array ] keep set-vector-array ; inline
+    [ vector-array grow-array ] keep set-vector-array ;
 
 : ensure-capacity ( n vec -- )
     #! If n is beyond the vector's length, increase the length,
@@ -41,7 +41,7 @@ IN: kernel-internals
         (set-vector-length)
     ] [
         2drop
-    ] ifte ; inline
+    ] ifte ;
 
 : copy-array ( to from n -- )
     [ 3dup swap array-nth pick rot set-array-nth ] repeat 2drop ;
@@ -95,7 +95,7 @@ IN: vectors
     #! vector with the results. The code must have stack effect
     #! ( obj -- obj ).
     over vector-length <vector> rot [
-        swap >r apply r> tuck vector-push
+        swap >r apply swap r> tuck vector-push
     ] vector-each nip ; inline
 
 : vector-nappend ( v1 v2 -- )

library/words.factor

@@ -43,15 +43,6 @@ PREDICATE: word primitive ( obj -- ? ) word-primitive 2 > ;
 PREDICATE: word symbol    ( obj -- ? ) word-primitive 2 = ;
 PREDICATE: word undefined ( obj -- ? ) word-primitive 0 = ;
 
-! These should really be somewhere in library/generic/, but
-! during bootstrap, we cannot execute parsing words after they
-! are defined by code loaded into the target image.
-PREDICATE: compound generic ( word -- ? )
-    "combination" word-property ;
-
-PREDICATE: compound promise ( obj -- ? )
-    "promise" word-property ;
-
 : define ( word primitive parameter -- )
     pick set-word-parameter
     over set-word-primitive

native/gc.c

@@ -126,9 +126,6 @@ void primitive_gc(void)
 
 	gc_in_progress = true;
 
-	fprintf(stderr,"GC\n");
-	fflush(stderr);
-
 	flip_zones();
 	scan = active.base;
 	collect_roots();