[ "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
: 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 -- )
embedded? [
"alien.remote-control"
] [
- main-vocab-hook get [ call ] [ "listener" ] if*
+ main-vocab-hook get [ call( -- vocab ) ] [ "listener" ] if*
] if ;
: default-cli-args ( -- )
: 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 ;
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 ;
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* ;
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 ;
--- /dev/null
+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
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 n -- quot' ) <repetition> >quotation ;
+: 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 ;
{ 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
PRIVATE>
: stop ( -- )
- self [ exit-handler>> call ] [ unregister-thread ] bi next ;
+ self [ exit-handler>> call( -- ) ] [ unregister-thread ] bi next ;
: suspend ( quot state -- obj )
[
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
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
[ this-test get failure ] recover
] [
call
- ] if ;
+ ] if ; inline
: unit-test ( output input -- )
[ 2array ] 2keep '[
} 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 ;
[ [ 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 ;
-! 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 ;
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 ;
: 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.
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
"<<" [
[
\ >> parse-until >quotation
- ] with-nested-compilation-unit call
+ ] with-nested-compilation-unit call( -- )
] define-syntax
"call-next-method" [
: run ( vocab -- )
dup load-vocab vocab-main [
- execute
+ execute( -- )
] [
"The " write vocab-name write
" vocabulary does not define an entry point." print