Merge branch 'master' of git://factorcode.org/git/factor
commit
37a16b35a6
|
@ -30,10 +30,3 @@ words splitting grouping sorting ;
|
||||||
\ + stack-trace-contains?
|
\ + stack-trace-contains?
|
||||||
\ > stack-trace-contains?
|
\ > stack-trace-contains?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
: quux ( -- seq ) { 1 2 3 } [ "hi" throw ] sort ;
|
|
||||||
|
|
||||||
[ t ] [
|
|
||||||
[ 10 quux ] ignore-errors
|
|
||||||
\ sort stack-trace-contains?
|
|
||||||
] unit-test
|
|
||||||
|
|
|
@ -219,7 +219,7 @@ M: number detect-number ;
|
||||||
|
|
||||||
! Regression
|
! Regression
|
||||||
USE: sorting
|
USE: sorting
|
||||||
USE: sorting.private
|
USE: binary-search.private
|
||||||
|
|
||||||
: old-binsearch ( elt quot seq -- elt quot i )
|
: old-binsearch ( elt quot seq -- elt quot i )
|
||||||
dup length 1 <= [
|
dup length 1 <= [
|
||||||
|
@ -227,7 +227,7 @@ USE: sorting.private
|
||||||
] [
|
] [
|
||||||
[ midpoint swap call ] 3keep roll dup zero?
|
[ midpoint swap call ] 3keep roll dup zero?
|
||||||
[ drop dup slice-from swap midpoint@ + ]
|
[ drop dup slice-from swap midpoint@ + ]
|
||||||
[ partition old-binsearch ] if
|
[ dup midpoint@ cut-slice old-binsearch ] if
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
|
||||||
[ 10 ] [
|
[ 10 ] [
|
||||||
|
|
|
@ -0,0 +1,65 @@
|
||||||
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: backtrack shuffle math math.ranges quotations locals fry
|
||||||
|
kernel words io memoize macros io prettyprint sequences assocs
|
||||||
|
combinators namespaces ;
|
||||||
|
IN: benchmark.backtrack
|
||||||
|
|
||||||
|
! This was suggested by Dr_Ford. Compute the number of quadruples
|
||||||
|
! (a,b,c,d) with 1 <= a,b,c,d <= 10 such that we can make 24 by
|
||||||
|
! placing them on the stack, and applying the operations
|
||||||
|
! +, -, * and rot as many times as we wish.
|
||||||
|
|
||||||
|
: nop ;
|
||||||
|
|
||||||
|
MACRO: amb-execute ( seq -- quot )
|
||||||
|
[ length ] [ <enum> [ 1quotation ] assoc-map ] bi
|
||||||
|
'[ , amb , case ] ;
|
||||||
|
|
||||||
|
: if-amb ( true false -- )
|
||||||
|
[
|
||||||
|
[ { t f } amb ]
|
||||||
|
[ '[ @ require t ] ]
|
||||||
|
[ '[ @ f ] ]
|
||||||
|
tri* if
|
||||||
|
] with-scope ; inline
|
||||||
|
|
||||||
|
: do-something ( a b -- c )
|
||||||
|
{ + - * } amb-execute ;
|
||||||
|
|
||||||
|
: some-rots ( a b c -- a b c )
|
||||||
|
#! Try to rot 0, 1 or 2 times.
|
||||||
|
{ nop rot -rot } amb-execute ;
|
||||||
|
|
||||||
|
MEMO: 24-from-1 ( a -- ? )
|
||||||
|
24 = ;
|
||||||
|
|
||||||
|
MEMO: 24-from-2 ( a b -- ? )
|
||||||
|
[ do-something 24-from-1 ] [ 2drop ] if-amb ;
|
||||||
|
|
||||||
|
MEMO: 24-from-3 ( a b c -- ? )
|
||||||
|
[ some-rots do-something 24-from-2 ] [ 3drop ] if-amb ;
|
||||||
|
|
||||||
|
MEMO: 24-from-4 ( a b c d -- ? )
|
||||||
|
[ some-rots do-something 24-from-3 ] [ 4drop ] if-amb ;
|
||||||
|
|
||||||
|
: find-impossible-24 ( -- n )
|
||||||
|
1 10 [a,b] [| a |
|
||||||
|
1 10 [a,b] [| b |
|
||||||
|
1 10 [a,b] [| c |
|
||||||
|
1 10 [a,b] [| d |
|
||||||
|
a b c d 24-from-4
|
||||||
|
] count
|
||||||
|
] sigma
|
||||||
|
] sigma
|
||||||
|
] sigma ;
|
||||||
|
|
||||||
|
: words { 24-from-1 24-from-2 24-from-3 24-from-4 } ;
|
||||||
|
|
||||||
|
: backtrack-benchmark ( -- )
|
||||||
|
words [ reset-memoized ] each
|
||||||
|
find-impossible-24 pprint "/10000 quadruples can make 24." print
|
||||||
|
words [
|
||||||
|
dup pprint " tested " write "memoize" word-prop assoc-size pprint
|
||||||
|
" possibilities" print
|
||||||
|
] each ;
|
|
@ -17,7 +17,7 @@ IN: channels.tests
|
||||||
from
|
from
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ V{ 1 2 3 4 } } [
|
{ { 1 2 3 4 } } [
|
||||||
V{ } clone <channel>
|
V{ } clone <channel>
|
||||||
[ from swap push ] in-thread
|
[ from swap push ] in-thread
|
||||||
[ from swap push ] in-thread
|
[ from swap push ] in-thread
|
||||||
|
@ -30,7 +30,7 @@ IN: channels.tests
|
||||||
natural-sort
|
natural-sort
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ V{ 1 2 4 9 } } [
|
{ { 1 2 4 9 } } [
|
||||||
V{ } clone <channel>
|
V{ } clone <channel>
|
||||||
[ 4 swap to ] in-thread
|
[ 4 swap to ] in-thread
|
||||||
[ 2 swap to ] in-thread
|
[ 2 swap to ] in-thread
|
||||||
|
|
|
@ -49,7 +49,7 @@ kernel strings ;
|
||||||
{ { object ppc object } "b" }
|
{ { object ppc object } "b" }
|
||||||
{ { string object windows } "c" }
|
{ { string object windows } "c" }
|
||||||
}
|
}
|
||||||
V{ cpu os }
|
{ cpu os }
|
||||||
] [
|
] [
|
||||||
example-1 canonicalize-specializers
|
example-1 canonicalize-specializers
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
Loading…
Reference in New Issue