Make more code infer

basis/bootstrap/stage2.factor

@@ -30,7 +30,7 @@ SYMBOL: bootstrap-time
     [ "bootstrap." prepend require ] each ;
 
 : count-words ( pred -- )
-    all-words swap count number>string write ;
+    all-words swap count number>string write ; inline
 
 : print-time ( ms -- )
     1000 /i

basis/cocoa/subclassing/subclassing.factor

@@ -8,7 +8,7 @@ IN: cocoa.subclassing
 
 : init-method ( method -- sel imp types )
     first3 swap
-    [ sel_registerName ] [ execute ] [ utf8 string>alien ]
+    [ sel_registerName ] [ execute( -- xt ) ] [ utf8 string>alien ]
     tri* ;
 
 : throw-if-false ( obj what -- )

basis/command-line/command-line.factor

@@ -54,7 +54,7 @@ SYMBOL: main-vocab-hook
     embedded? [
         "alien.remote-control"
     ] [
-        main-vocab-hook get [ call ] [ "listener" ] if*
+        main-vocab-hook get [ call( -- vocab ) ] [ "listener" ] if*
     ] if ;
 
 : default-cli-args ( -- )

basis/editors/editors.factor

@@ -28,7 +28,7 @@ SYMBOL: edit-hook
 
 : edit-location ( file line -- )
     [ (normalize-path) ] dip edit-hook get-global
-    [ call ] [ no-edit-hook edit-location ] if* ;
+    [ call( file line -- ) ] [ no-edit-hook edit-location ] if* ;
 
 ERROR: cannot-find-source definition ;
 

basis/functors/functors.factor

@@ -36,7 +36,7 @@ M: array fake-quotations> [ fake-quotations> ] map ;
 
 M: object fake-quotations> ;
 
-: parse-definition* ( -- )
+: parse-definition* ( accum -- accum )
     parse-definition >fake-quotations parsed \ fake-quotations> parsed ;
 
 : DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ;

basis/help/help.factor

@@ -140,7 +140,7 @@ help-hook [ [ print-topic ] ] initialize
     sort-articles [ \ $subsection swap 2array ] map print-element ;
 
 : $index ( element -- )
-    first call [ ($index) ] unless-empty ;
+    first call( -- seq ) [ ($index) ] unless-empty ;
 
 : $about ( element -- )
     first vocab-help [ 1array $subsection ] when* ;

basis/help/lint/lint.factor

@@ -13,14 +13,14 @@ IN: help.lint
 SYMBOL: vocabs-quot
 
 : check-example ( element -- )
-    [
+    '[
-        rest [
+        _ rest [
             but-last "\n" join
             [ (eval>string) ] call( code -- output )
             "\n" ?tail drop
         ] keep
         peek assert=
-    ] vocabs-quot get call ;
+    ] vocabs-quot get call( quot -- ) ;
 
 : check-examples ( element -- )
     \ $example swap elements [ check-example ] each ;

basis/stack-checker/call-effect/call-effect-tests.factor

@@ -0,0 +1,7 @@
+USING: stack-checker.call-effect tools.test math kernel ;
+IN: stack-checker.call-effect.tests
+
+[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
+[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
+[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
+[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test

basis/stack-checker/transforms/transforms-tests.factor

@@ -3,8 +3,8 @@ USING: sequences stack-checker.transforms tools.test math kernel
 quotations stack-checker accessors combinators words arrays
 classes classes.tuple ;
 
-: compose-n-quot ( word -- quot' ) <repetition> >quotation ;
+: compose-n-quot ( word n -- quot' ) <repetition> >quotation ;
-: compose-n ( quot -- ) compose-n-quot call ;
+: compose-n ( quot n -- ) compose-n-quot call ;
 \ compose-n [ compose-n-quot ] 2 define-transform
 : compose-n-test ( a b c -- x ) 2 \ + compose-n ;
 
@@ -66,8 +66,3 @@ DEFER: curry-folding-test ( quot -- )
 { 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as
 { 3 0 } [ 1 [ 2 3 ] curry curry-folding-test ] must-infer-as
 { 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
-
-[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
-[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
-[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
-[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test

basis/threads/threads.factor

@@ -160,7 +160,7 @@ DEFER: next
 PRIVATE>
 
 : stop ( -- )
-    self [ exit-handler>> call ] [ unregister-thread ] bi next ;
+    self [ exit-handler>> call( -- ) ] [ unregister-thread ] bi next ;
 
 : suspend ( quot state -- obj )
     [

basis/tools/annotations/annotations.factor

@@ -39,13 +39,13 @@ ERROR: cannot-annotate-twice word ;
     dup def>> "unannotated-def" set-word-prop ;
 
 : (annotate) ( word quot -- )
-    [ dup def>> ] dip call define ; inline
+    [ dup def>> ] dip call( old -- new ) define ;
 
 PRIVATE>
 
 : annotate ( word quot -- )
     [ method-spec>word check-annotate-twice ] dip
-    [ over save-unannotated-def (annotate) ] with-compilation-unit ; inline
+    [ over save-unannotated-def (annotate) ] with-compilation-unit ;
 
 <PRIVATE
 

basis/tools/deploy/deploy-tests.factor

@@ -1,10 +1,9 @@
 IN: tools.deploy.tests
 USING: tools.test system io.pathnames io.files io.files.info
-io.files.temp kernel tools.deploy.config
+io.files.temp kernel tools.deploy.config tools.deploy.config.editor
-tools.deploy.config.editor tools.deploy.backend math sequences
+tools.deploy.backend math sequences io.launcher arrays namespaces
-io.launcher arrays namespaces continuations layouts accessors
+continuations layouts accessors io.encodings.ascii urls math.parser
-io.encodings.ascii urls math.parser io.directories
+io.directories tools.deploy.test ;
-tools.deploy.test ;
 
 [ t ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test
 

basis/tools/test/test.factor

@@ -23,7 +23,7 @@ SYMBOL: this-test
         [ this-test get failure ] recover
     ] [
         call
-    ] if ;
+    ] if ; inline
 
 : unit-test ( output input -- )
     [ 2array ] 2keep '[

basis/tools/vocabs/browser/browser.factor

@@ -244,11 +244,7 @@ C: <vocab-author> vocab-author
     } cleave ;
 
 : keyed-vocabs ( str quot -- seq )
-    all-vocabs [
+    [ all-vocabs ] 2dip '[ [ _ swap @ member? ] filter ] assoc-map ; inline
-        swap [
-            [ [ 2dup ] dip swap call member? ] filter
-        ] dip swap
-    ] assoc-map 2nip ; inline
 
 : tagged ( tag -- assoc )
     [ vocab-tags ] keyed-vocabs ;

basis/tr/tr.factor

@@ -17,7 +17,8 @@ M: bad-tr summary
     [ [ ascii? ] all? ] both? [ bad-tr ] unless ;
 
 : compute-tr ( quot from to -- mapping )
-    zip [ 128 ] 2dip '[ [ @ _ at ] keep or ] B{ } map-as ; inline
+    [ 128 ] 3dip zip
+    '[ [ _ call( x -- y ) _ at ] keep or ] B{ } map-as ; inline
 
 : tr-hints ( word -- )
     { { byte-array } { string } } "specializer" set-word-prop ;

core/init/init.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations continuations.private kernel
 kernel.private sequences assocs namespaces namespaces.private ;
@@ -9,10 +9,10 @@ SYMBOL: init-hooks
 init-hooks global [ drop V{ } clone ] cache drop
 
 : do-init-hooks ( -- )
-    init-hooks get [ nip call ] assoc-each ;
+    init-hooks get [ nip call( -- ) ] assoc-each ;
 
 : add-init-hook ( quot name -- )
-    dup init-hooks get at [ over call ] unless
+    dup init-hooks get at [ over call( -- ) ] unless
     init-hooks get set-at ;
 
 : boot ( -- ) init-namespaces init-catchstack init-error-handler ;

core/io/backend/backend.factor

@@ -39,7 +39,7 @@ M: object normalize-directory normalize-path ;
 
 : set-io-backend ( io-backend -- )
     io-backend set-global init-io init-stdio
-    "io.files" init-hooks get at call ;
+    "io.files" init-hooks get at call( -- ) ;
 
 ! Note that we have 'alien' in our using list so that the alien
 ! init hook runs before this one.

core/syntax/syntax.factor

@@ -80,7 +80,7 @@ IN: bootstrap.syntax
         scan {
             { [ dup length 1 = ] [ first ] }
             { [ "\\" ?head ] [ next-escape >string "" assert= ] }
-            [ name>char-hook get call ]
+            [ name>char-hook get call( name -- char ) ]
         } cond parsed
     ] define-syntax
 
@@ -231,7 +231,7 @@ IN: bootstrap.syntax
     "<<" [
         [
             \ >> parse-until >quotation
-        ] with-nested-compilation-unit call
+        ] with-nested-compilation-unit call( -- )
     ] define-syntax
 
     "call-next-method" [

core/vocabs/loader/loader.factor

@@ -90,7 +90,7 @@ PRIVATE>
 
 : run ( vocab -- )
     dup load-vocab vocab-main [
-        execute
+        execute( -- )
     ] [
         "The " write vocab-name write
         " vocabulary does not define an entry point." print