Merge branch 'master' of git://factorcode.org/git/factor
commit
1e70b726e8
|
@ -33,7 +33,7 @@ IN: compiler.tests.curry
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
: foobar ( quot: ( -- ) -- )
|
: foobar ( quot: ( -- ) -- )
|
||||||
dup slip swap [ foobar ] [ drop ] if ; inline recursive
|
[ call ] keep swap [ foobar ] [ drop ] if ; inline recursive
|
||||||
|
|
||||||
[ ] [ [ [ f ] foobar ] compile-call ] unit-test
|
[ ] [ [ [ f ] foobar ] compile-call ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -302,7 +302,7 @@ C: <ro-box> ro-box
|
||||||
[ 0 ] [ [ 1 cons boa "x" get slot ] count-unboxed-allocations ] unit-test
|
[ 0 ] [ [ 1 cons boa "x" get slot ] count-unboxed-allocations ] unit-test
|
||||||
|
|
||||||
: impeach-node ( quot: ( node -- ) -- )
|
: impeach-node ( quot: ( node -- ) -- )
|
||||||
dup slip impeach-node ; inline recursive
|
[ call ] keep impeach-node ; inline recursive
|
||||||
|
|
||||||
: bleach-node ( quot: ( node -- ) -- )
|
: bleach-node ( quot: ( node -- ) -- )
|
||||||
[ bleach-node ] curry [ ] compose impeach-node ; inline recursive
|
[ bleach-node ] curry [ ] compose impeach-node ; inline recursive
|
||||||
|
|
|
@ -39,7 +39,7 @@ TUPLE: empty-tuple ;
|
||||||
|
|
||||||
! A more complicated example
|
! A more complicated example
|
||||||
: impeach-node ( quot: ( node -- ) -- )
|
: impeach-node ( quot: ( node -- ) -- )
|
||||||
dup slip impeach-node ; inline recursive
|
[ call ] keep impeach-node ; inline recursive
|
||||||
|
|
||||||
: bleach-node ( quot: ( node -- ) -- )
|
: bleach-node ( quot: ( node -- ) -- )
|
||||||
[ bleach-node ] curry [ ] compose impeach-node ; inline recursive
|
[ bleach-node ] curry [ ] compose impeach-node ; inline recursive
|
||||||
|
|
|
@ -180,7 +180,7 @@ DEFER: blah4
|
||||||
over [
|
over [
|
||||||
2drop
|
2drop
|
||||||
] [
|
] [
|
||||||
[ swap slip ] keep swap bad-combinator
|
[ dip ] keep swap bad-combinator
|
||||||
] if ; inline recursive
|
] if ; inline recursive
|
||||||
|
|
||||||
[ [ [ 1 ] [ ] bad-combinator ] infer ] must-fail
|
[ [ [ 1 ] [ ] bad-combinator ] infer ] must-fail
|
||||||
|
|
|
@ -40,6 +40,6 @@ COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}
|
||||||
IUnknown::Release drop ; inline
|
IUnknown::Release drop ; inline
|
||||||
|
|
||||||
: with-com-interface ( interface quot -- )
|
: with-com-interface ( interface quot -- )
|
||||||
over [ slip ] [ com-release ] [ ] cleanup ; inline
|
over [ com-release ] curry [ ] cleanup ; inline
|
||||||
|
|
||||||
DESTRUCTOR: com-release
|
DESTRUCTOR: com-release
|
||||||
|
|
|
@ -93,7 +93,7 @@ unless
|
||||||
|
|
||||||
: compile-alien-callback ( word return parameters abi quot -- word )
|
: compile-alien-callback ( word return parameters abi quot -- word )
|
||||||
'[ _ _ _ _ alien-callback ]
|
'[ _ _ _ _ alien-callback ]
|
||||||
[ [ (( -- alien )) define-declared ] pick slip ]
|
[ [ (( -- alien )) define-declared ] pick [ call ] dip ]
|
||||||
with-compilation-unit ;
|
with-compilation-unit ;
|
||||||
|
|
||||||
: (callback-word) ( function-name interface-name counter -- word )
|
: (callback-word) ( function-name interface-name counter -- word )
|
||||||
|
|
|
@ -61,20 +61,16 @@ IN: kernel.tests
|
||||||
[ 2 ] [ f 2 xor ] unit-test
|
[ 2 ] [ f 2 xor ] unit-test
|
||||||
[ f ] [ f f xor ] unit-test
|
[ f ] [ f f xor ] unit-test
|
||||||
|
|
||||||
[ slip ] must-fail
|
[ dip ] must-fail
|
||||||
[ ] [ :c ] unit-test
|
[ ] [ :c ] unit-test
|
||||||
|
|
||||||
[ 1 slip ] must-fail
|
[ 1 [ call ] dip ] must-fail
|
||||||
[ ] [ :c ] unit-test
|
[ ] [ :c ] unit-test
|
||||||
|
|
||||||
[ 1 2 slip ] must-fail
|
[ 1 2 [ call ] dip ] must-fail
|
||||||
[ ] [ :c ] unit-test
|
[ ] [ :c ] unit-test
|
||||||
|
|
||||||
[ 1 2 3 slip ] must-fail
|
[ 5 ] [ 1 [ 2 2 + ] dip + ] unit-test
|
||||||
[ ] [ :c ] unit-test
|
|
||||||
|
|
||||||
|
|
||||||
[ 5 ] [ [ 2 2 + ] 1 slip + ] unit-test
|
|
||||||
|
|
||||||
[ [ ] keep ] must-fail
|
[ [ ] keep ] must-fail
|
||||||
|
|
||||||
|
|
|
@ -1 +0,0 @@
|
||||||
Doug Coleman
|
|
|
@ -1,4 +0,0 @@
|
||||||
USING: crypto.timing kernel tools.test system math ;
|
|
||||||
IN: crypto.timing.tests
|
|
||||||
|
|
||||||
[ t ] [ millis [ ] 1000 with-timing millis swap - 1000 >= ] unit-test
|
|
|
@ -1,8 +0,0 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: kernel math threads system calendar ;
|
|
||||||
IN: crypto.timing
|
|
||||||
|
|
||||||
: with-timing ( quot n -- )
|
|
||||||
#! force the quotation to execute in, at minimum, n milliseconds
|
|
||||||
millis 2slip millis - + milliseconds sleep ; inline
|
|
|
@ -19,13 +19,11 @@ IN: reports.noise
|
||||||
{ 2keep 1 }
|
{ 2keep 1 }
|
||||||
{ 2nip 2 }
|
{ 2nip 2 }
|
||||||
{ 2over 4 }
|
{ 2over 4 }
|
||||||
{ 2slip 2 }
|
|
||||||
{ 2swap 3 }
|
{ 2swap 3 }
|
||||||
{ 3curry 2 }
|
{ 3curry 2 }
|
||||||
{ 3drop 1 }
|
{ 3drop 1 }
|
||||||
{ 3dup 2 }
|
{ 3dup 2 }
|
||||||
{ 3keep 3 }
|
{ 3keep 3 }
|
||||||
{ 3slip 3 }
|
|
||||||
{ 4drop 2 }
|
{ 4drop 2 }
|
||||||
{ 4dup 3 }
|
{ 4dup 3 }
|
||||||
{ compose 1/2 }
|
{ compose 1/2 }
|
||||||
|
@ -58,7 +56,6 @@ IN: reports.noise
|
||||||
{ pick 4 }
|
{ pick 4 }
|
||||||
{ roll 4 }
|
{ roll 4 }
|
||||||
{ rot 3 }
|
{ rot 3 }
|
||||||
{ slip 1 }
|
|
||||||
{ spin 3 }
|
{ spin 3 }
|
||||||
{ swap 1 }
|
{ swap 1 }
|
||||||
{ swapd 3 }
|
{ swapd 3 }
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Doug Coleman.
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors assocs deques dlists kernel spider ;
|
USING: accessors assocs deques dlists kernel ;
|
||||||
IN: spider.unique-deque
|
IN: spider.unique-deque
|
||||||
|
|
||||||
TUPLE: todo-url url depth ;
|
TUPLE: todo-url url depth ;
|
||||||
|
@ -32,6 +32,6 @@ TUPLE: unique-deque assoc deque ;
|
||||||
|
|
||||||
: slurp-deque-when ( deque quot1 quot2: ( value -- ) -- )
|
: slurp-deque-when ( deque quot1 quot2: ( value -- ) -- )
|
||||||
pick deque-empty? [ 3drop ] [
|
pick deque-empty? [ 3drop ] [
|
||||||
[ [ pop-front dup ] 2dip slip [ t ] compose [ drop f ] if ]
|
[ [ pop-front dup ] 2dip [ call ] dip [ t ] compose [ drop f ] if ]
|
||||||
[ roll [ slurp-deque-when ] [ 3drop ] if ] 3bi
|
[ roll [ slurp-deque-when ] [ 3drop ] if ] 3bi
|
||||||
] if ; inline recursive
|
] if ; inline recursive
|
||||||
|
|
Loading…
Reference in New Issue