Merge remote-tracking branch 'origin/master' into modern-harvey3
commit
4a86d45c17
|
@ -59,7 +59,7 @@ delete-staging-images
|
|||
! { } [ "bunny" shake-and-bake 2559640 small-enough? ] long-unit-test
|
||||
{ } [ "bunny" shake-and-bake 2700000 small-enough? ] long-unit-test
|
||||
|
||||
{ } [ "gpu.demos.bunny" shake-and-bake 3660000 small-enough? ] long-unit-test
|
||||
{ } [ "gpu.demos.bunny" shake-and-bake 3750000 small-enough? ] long-unit-test
|
||||
|
||||
os macosx? [
|
||||
[ ] [ "webkit-demo" shake-and-bake 600000 small-enough? ] long-unit-test
|
||||
|
|
|
@ -85,7 +85,8 @@ M: memoized reset-word
|
|||
bi ;
|
||||
|
||||
: memoize-quot ( quot effect -- memo-quot )
|
||||
[ H{ } clone ] 2dip make-memoizer ;
|
||||
dup in>> length zero? [ f 1array ] [ H{ } clone ] if
|
||||
-rot make-memoizer ;
|
||||
|
||||
: reset-memoized ( word -- )
|
||||
"memoize" word-prop dup sequence?
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
USING: tools.test math kernel sequences lists promises monads ;
|
||||
USING: tools.test math math.functions kernel sequences lists
|
||||
promises monads ;
|
||||
FROM: monads => do ;
|
||||
IN: monads.tests
|
||||
|
||||
|
@ -113,6 +114,22 @@ LAZY: nats-from ( n -- list )
|
|||
run-writer
|
||||
] unit-test
|
||||
|
||||
{
|
||||
T{ writer
|
||||
{ value 1.618033988749895 }
|
||||
{ log
|
||||
"Started with five, took square root, added one, divided by two."
|
||||
}
|
||||
}
|
||||
} [
|
||||
{
|
||||
[ 5 "Started with five, " <writer> ]
|
||||
[ sqrt "took square root, " <writer> ]
|
||||
[ 1 + "added one, " <writer> ]
|
||||
[ 2 / "divided by two." <writer> ]
|
||||
} do
|
||||
] unit-test
|
||||
|
||||
{ T{ identity f 7 } }
|
||||
[
|
||||
4 identity-monad return
|
||||
|
|
|
@ -188,7 +188,7 @@ M: writer-monad fail "Fail" throw ;
|
|||
|
||||
: run-writer ( writer -- value log ) [ value>> ] [ log>> ] bi ;
|
||||
|
||||
M: writer >>= '[ [ _ run-writer ] dip '[ @ run-writer ] dip append <writer> ] ;
|
||||
M: writer >>= '[ [ _ run-writer ] dip '[ @ run-writer ] dip prepend <writer> ] ;
|
||||
|
||||
: pass ( writer -- writer' ) run-writer [ first2 ] dip swap call( x -- y ) <writer> ;
|
||||
: listen ( writer -- writer' ) run-writer [ 2array ] keep <writer> ;
|
||||
|
|
Loading…
Reference in New Issue