]> gitweb.factorcode.org Git - factor.git/commitdiff
Make more code infer
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 17 Mar 2009 07:19:50 +0000 (02:19 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 17 Mar 2009 07:19:50 +0000 (02:19 -0500)
19 files changed:
basis/bootstrap/stage2.factor
basis/cocoa/subclassing/subclassing.factor
basis/command-line/command-line.factor
basis/editors/editors.factor
basis/functors/functors.factor
basis/help/help.factor
basis/help/lint/lint.factor
basis/stack-checker/call-effect/call-effect-tests.factor [new file with mode: 0644]
basis/stack-checker/transforms/transforms-tests.factor
basis/threads/threads.factor
basis/tools/annotations/annotations.factor
basis/tools/deploy/deploy-tests.factor
basis/tools/test/test.factor
basis/tools/vocabs/browser/browser.factor
basis/tr/tr.factor
core/init/init.factor
core/io/backend/backend.factor
core/syntax/syntax.factor
core/vocabs/loader/loader.factor

index 070618ebb487eaa39c9266aaa71d21d19b393af6..6c824b6155745e7b1cdac3be454ae76a128c896d 100644 (file)
@@ -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
index 394f45bef39fdfd25082233118e2045c85acf5be..c3f1b471e0a72dcfbb4b352cba8ba99aa12d21c2 100644 (file)
@@ -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 -- )
index 38d40d84828b0055873718a7c3be9221e151d3c1..73a01aa352a7640fae860fb429a51243ed602caf 100644 (file)
@@ -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 ( -- )
index d060a3dfe67450042c47370bcb433cbc09fcc052..0003b508fb2c6903aad9e5532e3a2777d1d98bab 100644 (file)
@@ -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 ;
 
index 6592a3c4f241fe938a135067b8b80d882276d47d..caa41d6c2962a0e651bc70792363fe136c81ee6c 100644 (file)
@@ -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 ;
index d8629008d2078c3c0a70f0a516aefaafde1a6074..6fa4473d970eed65355f5ec0909926230d7f8014 100644 (file)
@@ -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* ;
index 7942f90e0a85a74762b9ae18d6b6b76859a9dbbe..7ec8c59ba6be75f0442004aed6d285527f3db086 100755 (executable)
@@ -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 ;
diff --git a/basis/stack-checker/call-effect/call-effect-tests.factor b/basis/stack-checker/call-effect/call-effect-tests.factor
new file mode 100644 (file)
index 0000000..e5c0f23
--- /dev/null
@@ -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
\ No newline at end of file
index 751e589c2801582e3aaafe7afce75de77fa1026e..521cf9fcb7064c33cd489d682bbeb6618c4465c7 100644 (file)
@@ -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 -- ) compose-n-quot call ;
+: compose-n-quot ( word -- quot' ) <repetition> >quotation ;
+: compose-n ( quot -- ) compose-n-quot call ;
 \ compose-n [ compose-n-quot ] 2 define-transform
 : compose-n-test ( a b c -- x ) 2 \ + compose-n ;
 
@@ -65,9 +65,4 @@ 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
\ No newline at end of file
+{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
\ No newline at end of file
index 1f25c0e0312770f59cc5c43400600e2945f61dd9..cacc628e2a5a6c7dff401bbc2cbf51b0f056de62 100644 (file)
@@ -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 )
     [
index 293a22d2bb95ea8e23a8f3eff39eb85d8b42f0b9..8c3d95f2b877e017892ebf2074fbc5c74cc2f91a 100644 (file)
@@ -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
 
index 40c4ae57215376471bda83ae39bab4b560911ad7..3a2f960fc93713b346f70eeadd3f601406eeabc7 100644 (file)
@@ -1,10 +1,9 @@
 IN: tools.deploy.tests\r
 USING: tools.test system io.pathnames io.files io.files.info\r
-io.files.temp kernel tools.deploy.config\r
-tools.deploy.config.editor tools.deploy.backend math sequences\r
-io.launcher arrays namespaces continuations layouts accessors\r
-io.encodings.ascii urls math.parser io.directories\r
-tools.deploy.test ;\r
+io.files.temp kernel tools.deploy.config tools.deploy.config.editor\r
+tools.deploy.backend math sequences io.launcher arrays namespaces\r
+continuations layouts accessors io.encodings.ascii urls math.parser\r
+io.directories tools.deploy.test ;\r
 \r
 [ t ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test\r
 \r
index 704a7f1bd5430d828ff504b1228f48ad382bf259..c6dea08d181556e9051b3dd3a310daa763b6b681 100644 (file)
@@ -23,7 +23,7 @@ SYMBOL: this-test
         [ this-test get failure ] recover
     ] [
         call
-    ] if ;
+    ] if ; inline
 
 : unit-test ( output input -- )
     [ 2array ] 2keep '[
index 6a3f2df8a37b3ecd8f33f1a6048e5d010660579e..c9ade7aae27877e35c8100cc941f9d6380cd3eb7 100644 (file)
@@ -244,11 +244,7 @@ C: <vocab-author> vocab-author
     } cleave ;
 
 : keyed-vocabs ( str quot -- seq )
-    all-vocabs [
-        swap [
-            [ [ 2dup ] dip swap call member? ] filter
-        ] dip swap
-    ] assoc-map 2nip ; inline
+    [ all-vocabs ] 2dip '[ [ _ swap @ member? ] filter ] assoc-map ; inline
 
 : tagged ( tag -- assoc )
     [ vocab-tags ] keyed-vocabs ;
index ce535f335aa9e1eeb1b2b4ab67c6a9e67e3248f3..66c0276055d460bc94242032f00289082e6f30b7 100644 (file)
@@ -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 ;
index 953340b985a5c064ece12fbc4516ba5e7b50e22d..5d8e88b85f5b2ee4a78109e618f868d8773cf913 100644 (file)
@@ -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 ;
index 2f0bb1063f80d4d7b46c7dcfc7efc17a1fe8e49c..4c91a519c6c93624710e77ec3991a0baf8d4118f 100644 (file)
@@ -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.
index f6d124d8da6445ffa755c5c3e5626121379b8ae3..d01a9ebb2c2422ed64e1c38c29d3efd288abaead 100644 (file)
@@ -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" [
index df6d2d02a7919520b44297b2da1ec1084927195a..4f9005e11061fed8915062e79b77c3d838be274f 100644 (file)
@@ -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