diff --git a/basis/eval/eval-docs.factor b/basis/eval/eval-docs.factor index b53c3bae6b..b30c6d9cb9 100644 --- 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 3672337a58..4c5b9e8cf9 100644 --- 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 91f1dcf1f8..ca9a86b6d9 100644 --- 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 7c9a38796b..3bb9ae72ac 100755 --- 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 b4f8622627..3310686f05 100644 --- 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 a16e3c82c5..5d6816121d 100644 --- 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 00023626a7..39e42aa723 100644 --- 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 e06872fa83..e4aaef9bbd 100644 --- 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 3394de87b2..1a2cf09129 100644 --- 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 aae0b40d38..b9679ec26b 100755 --- a/extra/4DNav/4DNav.factor +++ b/extra/4DNav/4DNav.factor @@ -75,8 +75,6 @@ VAR: present-space ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! namespace utilities - -: make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ; : closed-quot ( quot -- quot ) namestack swap '[ namestack [ _ set-namestack @ ] dip set-namestack ] ; @@ -156,9 +154,9 @@ VAR: present-space 3 model-projection view4> (>>model) ; : camera-action ( quot -- quot ) - [ drop [ ] observer3d> + '[ drop _ observer3d> with-self update-observer-projections ] - make* closed-quot ; + closed-quot ; : win3D ( text gadget -- ) "navigateur 4D : " rot append open-window ; @@ -400,7 +398,7 @@ M: handler handle-gesture ( gesture gadget -- ? ) : add-keyboard-delegate ( obj -- obj ) -{ +H{ { T{ key-down f f "LEFT" } [ [ rotation-step turn-left ] camera-action ] } { T{ key-down f f "RIGHT" } @@ -435,7 +433,7 @@ M: handler handle-gesture ( gesture gadget -- ? ) { T{ key-down f f "3" } [ mvt-3D-3 camera-action ] } { T{ key-down f f "4" } [ mvt-3D-4 camera-action ] } - } [ make* ] map >hashtable >>table + } >>table ; ! -------------------------------------------- diff --git a/extra/4DNav/file-chooser/file-chooser.factor b/extra/4DNav/file-chooser/file-chooser.factor index 9bd0e9c011..ad799f75c9 100755 --- 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 ) dup list-of-files >>model ; -: (fc-go) ( file-chooser quot -- ) +: (fc-go) ( file-chooser button quot -- ) [ [ file-chooser? ] find-parent dup path>> ] dip call normalize-path swap set-model update-filelist-model - drop ; + drop ; inline -: fc-go-parent ( file-chooser -- ) +: fc-go-parent ( file-chooser button -- ) [ dup value>> parent-directory ] (fc-go) ; -: fc-go-home ( file-chooser -- ) +: fc-go-home ( file-chooser button -- ) [ home ] (fc-go) ; : fc-change-directory ( file-chooser file -- ) diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor index ed268e558d..5597422898 100644 --- 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 02f5ce8b21..9f86336f96 100755 --- 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 ] 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 7ac69d2980..4ba8e2f66b 100755 --- 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 e3a009feb5..4bd1bc1b81 100644 --- 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 99e8099f38..030d0a2a73 100755 --- 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 ] [ 2drop nil ] if ] if ; diff --git a/extra/partial-continuations/partial-continuations.factor b/extra/partial-continuations/partial-continuations.factor index 7ec294ca2e..829679570e 100755 --- 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 90d2e0e34c..e7acf1f5bb 100644 --- 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 9d98ac6766..beed787fba 100644 --- 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 d6c98ea203..5f1c75ba8a 100644 --- 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 aa98793c70..5ff5bb3879 100644 --- 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 beeddc7abb..77cd916139 100644 --- 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 b60f1b1b6a..f82eb6dcd8 100644 --- a/extra/webapps/site-watcher/site-watcher.factor +++ b/extra/webapps/site-watcher/site-watcher.factor @@ -79,8 +79,7 @@ site-watcher-db main-responder set-global M: site-watcher-app init-user-profile - drop B - "username" value "email" value insert-tuple ; + drop "username" value "email" value 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 d0116a7f2d..a838c6763a 100644 --- 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 diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor index 34cd19c34f..11a1e325c3 100644 --- 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