Making more code infer

diff --git a/basis/eval/eval-docs.factor b/basis/eval/eval-docs.factor
index b53c3bae6bb040eda37fe7e186129594d642d1ee..b30c6d9cb93d83840535892dcff3fcbd06d9b134 100644 (file)
--- a/basis/eval/eval-docs.factor
+++ b/basis/eval/eval-docs.factor
@@ -1,18 +1,23 @@
 IN: eval
-USING: help.markup help.syntax strings io ;
+USING: help.markup help.syntax strings io effects ;
 
 HELP: eval
-{ $values { "str" string } }
-{ $description "Parses Factor source code from a string, and calls the resulting quotation." }
+{ $values { "str" string } { "effect" effect } }
+{ $description "Parses Factor source code from a string, and calls the resulting quotation, which must have the given stack effect." }
+{ $errors "Throws an error if the input is malformed, or if the evaluation itself throws an error." } ;
+
+HELP: eval(
+{ $syntax "eval( inputs -- outputs )" }
+{ $description "Parses Factor source code from the string at the top of the stack, and calls the resulting quotation, which must have the given stack effect." }
 { $errors "Throws an error if the input is malformed, or if the evaluation itself throws an error." } ;
 
 HELP: eval>string
 { $values { "str" string } { "output" string } }
-{ $description "Evaluates the Factor code in " { $snippet "str" } " with " { $link output-stream } " rebound to a string output stream, then outputs the resulting string." } ;
+{ $description "Evaluates the Factor code in " { $snippet "str" } " with " { $link output-stream } " rebound to a string output stream, then outputs the resulting string. The code in the string must not take or leave any values on the stack." } ;
 
 ARTICLE: "eval" "Evaluating strings at runtime"
 "The " { $vocab-link "eval" } " vocabulary implements support for evaluating strings at runtime."
-{ $subsection eval }
+{ $subsection POSTPONE: eval( }
 { $subsection eval>string } ;
 
 ABOUT: "eval"

diff --git a/basis/eval/eval.factor b/basis/eval/eval.factor
index 3672337a584d0f17f8860a816246f6ef87d93348..4c5b9e8cf9a72c0fb56860cd7cb01b22ef92a8a1 100644 (file)
--- a/basis/eval/eval.factor
+++ b/basis/eval/eval.factor
@@ -1,23 +1,25 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: splitting parser compiler.units kernel namespaces
-debugger io.streams.string fry ;
+debugger io.streams.string fry combinators effects.parser ;
 IN: eval
 
 : parse-string ( str -- quot )
     [ string-lines parse-lines ] with-compilation-unit ;
 
-: (eval) ( str -- )
-    parse-string call ;
+: (eval) ( str effect -- )
+    [ parse-string ] dip call-effect ; inline
 
-: eval ( str -- )
-    [ (eval) ] with-file-vocabs ;
+: eval ( str effect -- )
+    [ (eval) ] with-file-vocabs ; inline
+
+SYNTAX: eval( \ eval parse-call( ;
 
 : (eval>string) ( str -- output )
     [
         "quiet" on
         parser-notes off
-        '[ _ (eval) ] try
+        '[ _ (( -- )) (eval) ] try
     ] with-string-writer ;
 
 : eval>string ( str -- output )

diff --git a/basis/persistent/deques/deques.factor b/basis/persistent/deques/deques.factor
index 91f1dcf1f80b2a995a608e08904ac3199ee82cc2..ca9a86b6d92788a1d2e047a4f31eb66a08008232 100644 (file)
--- a/basis/persistent/deques/deques.factor
+++ b/basis/persistent/deques/deques.factor
@@ -21,7 +21,7 @@ TUPLE: deque { front read-only } { back read-only } ;
     [ back>> ] [ front>> ] bi deque boa ;
 
 : flipped ( deque quot -- newdeque )
-    [ flip ] dip call flip ;
+    [ flip ] dip call flip ; inline
 PRIVATE>
 
 : deque-empty? ( deque -- ? )

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 7c9a38796b5de053f56b9a0a3ba4c4f8c1bd64ff..3bb9ae72ac5b757af47f631a6fe38537bab7b03a 100755 (executable)
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -354,8 +354,6 @@ IN: tools.deploy.shaker
 
 : finish-deploy ( final-image -- )
     "Finishing up" show
-    [ { } set-datastack ] dip
-    { } set-retainstack
     V{ } set-namestack
     V{ } set-catchstack
     "Saving final image" show

diff --git a/basis/tools/deploy/test/11/11.factor b/basis/tools/deploy/test/11/11.factor
index b4f862262752c82aede515fbc851dd4d3d812cd6..3310686f05c307abb2db64747fb6f27c97633cb5 100644 (file)
--- a/basis/tools/deploy/test/11/11.factor
+++ b/basis/tools/deploy/test/11/11.factor
@@ -3,6 +3,6 @@
 USING: eval ;
 IN: tools.deploy.test.11
 
-: foo ( -- ) "USING: math prettyprint ; 2 2 + ." eval ;
+: foo ( -- ) "USING: math prettyprint ; 2 2 + ." eval( -- ) ;
 
 MAIN: foo
\ No newline at end of file

diff --git a/basis/tools/deploy/test/7/7.factor b/basis/tools/deploy/test/7/7.factor
index a16e3c82c565bbc81bd31337556d3c8bcf1d708b..5d6816121d28074dc7901141d5eb1a9e7cdafd1f 100644 (file)
--- a/basis/tools/deploy/test/7/7.factor
+++ b/basis/tools/deploy/test/7/7.factor
@@ -9,7 +9,7 @@ GENERIC: my-generic ( x -- b )
 
 M: integer my-generic sq ;
 
-M: fixnum my-generic call-next-method my-var get call ;
+M: fixnum my-generic call-next-method my-var get call( a -- b ) ;
 
 : test-7 ( -- )
     [ 1 + ] my-var set-global

diff --git a/basis/ui/gadgets/slots/slots.factor b/basis/ui/gadgets/slots/slots.factor
index 00023626a7e10cc27a9459656767476818156400..39e42aa723d7ffc1d79ce8ea440d84aefca641ef 100644 (file)
--- a/basis/ui/gadgets/slots/slots.factor
+++ b/basis/ui/gadgets/slots/slots.factor
@@ -44,11 +44,8 @@ TUPLE: slot-editor < track ref close-hook update-hook text ;
     { +description+ "Parse the object being edited, and store the result back into the edited slot." }
 } define-command
 
-: eval-1 ( string -- object )
-    1array [ eval ] with-datastack first ;
-
 : com-eval ( slot-editor -- )
-    [ [ text>> editor-string eval-1 ] [ ref>> ] bi set-ref ]
+    [ [ text>> editor-string eval( -- result ) ] [ ref>> ] bi set-ref ]
     [ close-and-update ]
     bi ;
 

diff --git a/basis/x11/xim/xim.factor b/basis/x11/xim/xim.factor
index e06872fa83456402e0f74de3f33638911106f268..e4aaef9bbd2903df52d923af94bcdec1e515b487 100644 (file)
--- a/basis/x11/xim/xim.factor
+++ b/basis/x11/xim/xim.factor
@@ -22,7 +22,7 @@ SYMBOL: xim
     xim get-global XCloseIM drop f xim set-global ;
 
 : with-xim ( quot -- )
-    [ "Factor" init-xim ] dip [ close-xim ] [ ] cleanup ;
+    [ "Factor" init-xim ] dip [ close-xim ] [ ] cleanup ; inline
 
 : create-xic ( window classname -- xic )
     [

diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor
index 3394de87b271cd9bdd9f4b24f9503281477f0c73..1a2cf091297054a6d200bf5622d0f4bf20ec8a73 100644 (file)
--- a/basis/x11/xlib/xlib.factor
+++ b/basis/x11/xlib/xlib.factor
@@ -1440,4 +1440,4 @@ SYMBOL: root
 : close-x ( -- ) dpy get XCloseDisplay drop ;
 
 : with-x ( display-string quot -- )
-    [ initialize-x ] dip [ close-x ] [ ] cleanup ;
+    [ initialize-x ] dip [ close-x ] [ ] cleanup ; inline

diff --git a/extra/4DNav/4DNav.factor b/extra/4DNav/4DNav.factor
index aae0b40d381b521ec920dd6df43dcf852a1dd145..b9679ec26beddbd600ad4b86b9e35f8538bd4235 100755 (executable)
--- a/extra/4DNav/4DNav.factor
+++ b/extra/4DNav/4DNav.factor
@@ -75,8 +75,6 @@ VAR: present-space
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
 \r
 ! namespace utilities\r
-    \r
-: make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ;\r
 \r
 : closed-quot ( quot -- quot )\r
   namestack swap '[ namestack [ _ set-namestack @ ] dip set-namestack ] ;\r
@@ -156,9 +154,9 @@ VAR: present-space
     3 model-projection <model> view4> (>>model) ;\r
 \r
 : camera-action ( quot -- quot ) \r
-    [ drop [ ] observer3d>  \r
+    '[ drop _ observer3d>  \r
     with-self update-observer-projections ] \r
-    make* closed-quot ;\r
+    closed-quot ;\r
 \r
 : win3D ( text gadget -- ) \r
     "navigateur 4D : " rot append open-window ;\r
@@ -400,7 +398,7 @@ M: handler handle-gesture ( gesture gadget -- ? )
 \r
 : add-keyboard-delegate ( obj -- obj )\r
  <handler>\r
-{\r
+H{\r
         { T{ key-down f f "LEFT" }  \r
             [ [ rotation-step turn-left ] camera-action ] }\r
         { T{ key-down f f "RIGHT" } \r
@@ -435,7 +433,7 @@ M: handler handle-gesture ( gesture gadget -- ? )
         { T{ key-down f f "3" } [ mvt-3D-3  camera-action ] }\r
         { T{ key-down f f "4" } [ mvt-3D-4  camera-action ] }\r
 \r
-    } [ make* ] map >hashtable >>table\r
+    } >>table\r
     ;    \r
 \r
 ! --------------------------------------------\r

diff --git a/extra/4DNav/file-chooser/file-chooser.factor b/extra/4DNav/file-chooser/file-chooser.factor
index 9bd0e9c011ae4570796ab6cfbcceb9d1f28570a5..ad799f75c96ea67b211177e904f5cdd320267177 100755 (executable)
--- a/extra/4DNav/file-chooser/file-chooser.factor
+++ b/extra/4DNav/file-chooser/file-chooser.factor
@@ -72,17 +72,17 @@ file-chooser H{
 : init-filelist-model ( file-chooser -- file-chooser )\r
     dup list-of-files <model> >>model ; \r
 \r
-: (fc-go) ( file-chooser quot -- )\r
+: (fc-go) ( file-chooser button quot -- )\r
     [ [ file-chooser? ] find-parent dup path>> ] dip\r
     call\r
     normalize-path swap set-model\r
     update-filelist-model\r
-    drop ;\r
+    drop ; inline\r
 \r
-: fc-go-parent ( file-chooser -- )\r
+: fc-go-parent ( file-chooser button -- )\r
     [ dup value>> parent-directory ] (fc-go) ;\r
 \r
-: fc-go-home ( file-chooser -- )\r
+: fc-go-home ( file-chooser button -- )\r
     [ home ] (fc-go) ;\r
 \r
 : fc-change-directory ( file-chooser file -- )\r

diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor
index ed268e558daaee26b47325b1ef03b13c6672861b..5597422898768672224e33f76c05fe8a97b87a0c 100644 (file)
--- a/extra/infix/infix.factor
+++ b/extra/infix/infix.factor
@@ -40,7 +40,7 @@ M: ast-array infix-codegen
 M: ast-op infix-codegen
     [ left>> infix-codegen ] [ right>> infix-codegen ]
     [ op>> select-op ] tri
-    2over [ number? ] both? [ call ] [
+    2over [ number? ] both? [ call( a b -- c ) ] [
         [ [ prepare-operand ] bi@ ] dip '[ @ @ @ ]
     ] if ;
 

diff --git a/extra/key-caps/key-caps.factor b/extra/key-caps/key-caps.factor
index 02f5ce8b21ebbaa8c08c4da6950a46ef1a20b0e1..9f86336f96229e7695a9aa83c75f108a0f1ad2f8 100755 (executable)
--- a/extra/key-caps/key-caps.factor
+++ b/extra/key-caps/key-caps.factor
@@ -141,7 +141,7 @@ TUPLE: key-caps-gadget < gadget keys alarm ;
         swap [ 
             " " [ drop ] <border-button>
             swap [ first >>loc ] [ second >>dim ] bi
-        ] [ execute ] bi*
+        ] [ execute( -- value ) ] bi*
     ] dip set-nth ;
 
 : add-keys-gadgets ( gadget -- gadget )

diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor
index 7ac69d298057301e834cba23108c15083180005a..4ba8e2f66b34fca014983b88a587f55a7da30be6 100755 (executable)
--- a/extra/koszul/koszul.factor
+++ b/extra/koszul/koszul.factor
@@ -165,7 +165,7 @@ DEFER: (d)
     swap call [ at 0 or ] curry map ; inline
 
 : op-matrix ( domain range quot -- matrix )
-    rot [ [ 2dup ] dip (op-matrix) ] map 2nip ; inline
+    rot [ (op-matrix) ] with with map ; inline
 
 : d-matrix ( domain range -- matrix )
     [ (d) ] op-matrix ;

diff --git a/extra/math/binpack/binpack.factor b/extra/math/binpack/binpack.factor
index e3a009feb5c6dfebefb96d972d156051c68542f2..4bd1bc1b81fcc3c0022386327db20f3ead24dee7 100644 (file)
--- a/extra/math/binpack/binpack.factor
+++ b/extra/math/binpack/binpack.factor
@@ -18,5 +18,5 @@ IN: math.binpack
     [ dup zip ] dip binpack [ keys ] map ;
 
 : binpack! ( items quot n -- bins ) 
-    [ dupd map zip ] dip binpack [ keys ] map ;
+    [ dupd map zip ] dip binpack [ keys ] map ; inline
 

diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor
index 99e8099f38e38bc92b47d2e9d4ec72e0f438fdb1..030d0a2a7350846091072034c68868d0bee76f4d 100755 (executable)
--- a/extra/parser-combinators/parser-combinators.factor
+++ b/extra/parser-combinators/parser-combinators.factor
@@ -76,7 +76,7 @@ M: satisfy-parser parse ( input parser -- list )
     over empty? [
         2drop nil
     ] [
-        quot>> [ unclip-slice dup ] dip call
+        quot>> [ unclip-slice dup ] dip call( char -- ? )
         [ swap <parse-results> ] [ 2drop nil ] if
     ] if ;
 

diff --git a/extra/partial-continuations/partial-continuations.factor b/extra/partial-continuations/partial-continuations.factor
index 7ec294ca2e9137d5364b774c41481725374c878f..829679570eecefeb8c95258db03ddc21955bdfbf 100755 (executable)
--- a/extra/partial-continuations/partial-continuations.factor
+++ b/extra/partial-continuations/partial-continuations.factor
@@ -4,7 +4,7 @@ IN: partial-continuations
 USING: kernel continuations arrays sequences quotations ;
 
 : breset ( quot -- )
-    [ 1array swap keep first continue-with ] callcc1 nip ;
+    [ 1array swap keep first continue-with ] callcc1 nip ; inline
 
 : (bshift) ( v r k -- obj )
     [ dup first -rot ] dip

diff --git a/extra/peg-lexer/peg-lexer.factor b/extra/peg-lexer/peg-lexer.factor
index 90d2e0e34c80d6782552400b2a36d6ba548a26cc..e7acf1f5bbe1b87feddbc4f839434ac92f7f5f6b 100644 (file)
--- a/extra/peg-lexer/peg-lexer.factor
+++ b/extra/peg-lexer/peg-lexer.factor
@@ -43,7 +43,7 @@ M: lex-hash at*
 
 : parse* ( parser -- ast )
     compile
-    [ execute [ error-stack get first throw ] unless* ] with-global-lexer
+    [ execute( -- result ) [ error-stack get first throw ] unless* ] with-global-lexer
     ast>> ;
 
 : create-bnf ( name parser -- )

diff --git a/extra/project-euler/011/011.factor b/extra/project-euler/011/011.factor
index 9d98ac67668817bbf2cdc514fdcabaaa2dfd602f..beed787fba1504fb86708b992623b3e386fa72bb 100644 (file)
--- a/extra/project-euler/011/011.factor
+++ b/extra/project-euler/011/011.factor
@@ -95,7 +95,7 @@ PRIVATE>
 : euler011 ( -- answer )
     [
         { [ horizontal ] [ vertical ] [ diagonal/ ] [ diagonal\ ] }
-        [ call 4 max-product , ] each
+        [ call( -- matrix ) 4 max-product , ] each
     ] { } make supremum ;
 
 ! [ euler011 ] 100 ave-time

diff --git a/extra/shell/shell.factor b/extra/shell/shell.factor
index d6c98ea203ab4b23e451bd6a43f6dc295b8f2c65..5f1c75ba8a0ee9607a960bd7ebd3937222950bf2 100644 (file)
--- a/extra/shell/shell.factor
+++ b/extra/shell/shell.factor
@@ -41,7 +41,7 @@ METHOD: expand { glob-expr }
     [ ]
   if ;
 
-METHOD: expand { factor-expr } expr>> eval unparse ;
+METHOD: expand { factor-expr } expr>> eval>string ;
 
 DEFER: expansion
 
@@ -64,7 +64,7 @@ METHOD: expand { object } ;
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : run-sword ( basic-expr -- )
-  command>> expansion unclip "shell" lookup execute ;
+  command>> expansion unclip "shell" lookup execute( arguments -- ) ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

diff --git a/extra/ui/gadgets/lists/lists.factor b/extra/ui/gadgets/lists/lists.factor
index aa98793c70ef6a2642e2288df9c6ae5b2877a409..5ff5bb38791e46072eb91a8969bc9aa3428899c3 100644 (file)
--- a/extra/ui/gadgets/lists/lists.factor
+++ b/extra/ui/gadgets/lists/lists.factor
@@ -90,7 +90,7 @@ M: list focusable-child* drop t ;
 
 : invoke-value-action ( list -- )
     dup list-empty? [
-        dup hook>> call
+        dup hook>> call( list -- )
     ] [
         [ index>> ] keep nth-gadget invoke-secondary
     ] if ;

diff --git a/extra/update/util/util.factor b/extra/update/util/util.factor
index beeddc7abb7ac8a0604eaf727b60721c8a80a679..77cd916139f9778fb13025559b01efdc128ac6a3 100644 (file)
--- a/extra/update/util/util.factor
+++ b/extra/update/util/util.factor
@@ -20,8 +20,8 @@ DEFER: to-strings
   dup class
     {
       { \ string    [ ] }
-      { \ quotation [ call ] }
-      { \ word      [ execute ] }
+      { \ quotation [ call( -- string ) ] }
+      { \ word      [ execute( -- string ) ] }
       { \ fixnum    [ number>string ] }
       { \ array     [ to-strings concat ] }
     }

diff --git a/extra/webapps/site-watcher/site-watcher.factor b/extra/webapps/site-watcher/site-watcher.factor
index b60f1b1b6a59abf7cff73eecd95f3cf7a96c7cc7..f82eb6dcd88594f3a1dcac50baa6e5494f58753d 100644 (file)
--- a/extra/webapps/site-watcher/site-watcher.factor
+++ b/extra/webapps/site-watcher/site-watcher.factor
@@ -79,8 +79,7 @@ site-watcher-db <alloy>
 main-responder set-global
 
 M: site-watcher-app init-user-profile
-    drop B
-    "username" value "email" value <account> insert-tuple ;
+    drop "username" value "email" value <account> insert-tuple ;
 
 : init-db ( -- )
     site-watcher-db [

diff --git a/extra/webapps/site-watcher/spidering/spidering.factor b/extra/webapps/site-watcher/spidering/spidering.factor
index d0116a7f2dc3060e5c60b9e8e5d117d6cb950b5d..a838c6763aecd4588f209da7ac13348a576d1095 100644 (file)
--- a/extra/webapps/site-watcher/spidering/spidering.factor
+++ b/extra/webapps/site-watcher/spidering/spidering.factor
@@ -12,7 +12,7 @@ CONSTANT: site-list-url URL" $site-watcher-app/spider-list"
         { site-watcher-app "spider-list" } >>template
         [
             ! Silly query
-            username B spidering-sites [ site>> ] map
+            username spidering-sites [ site>> ] map
             "sites" set-value
         ] >>init
     <protected>

diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor
index 34cd19c34fc99344f8b86536dfd7a51f4cf2d703..11a1e325c3f857961c350fadae02c20c6e98c0b3 100644 (file)
--- a/extra/wordtimer/wordtimer.factor
+++ b/extra/wordtimer/wordtimer.factor
@@ -58,7 +58,7 @@ SYMBOL: *calling*
   swap [ * - ] keep 2array ;
   
 : change-global ( variable quot -- )
-  global swap change-at ;
+  global swap change-at ; inline
 
 : (correct-for-timing-overhead) ( timingshash -- timingshash )
   time-dummy-word [ subtract-overhead ] curry assoc-map ;  
@@ -75,7 +75,7 @@ SYMBOL: *calling*
       correct-for-timing-overhead
       "total time:" write
   ] dip pprint nl
-  print-word-timings nl ;
+  print-word-timings nl ; inline
 
 : profile-vocab ( vocab quot -- )
   "annotating vocab..." print flush
@@ -88,4 +88,4 @@ SYMBOL: *calling*
       correct-for-timing-overhead
       "total time:" write
   ] dip pprint
-  print-word-timings ;
+  print-word-timings ; inline