diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index 6ad4627851..4e6dac91bd 100644 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -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 diff --git a/core/memoize/memoize.factor b/core/memoize/memoize.factor index cdf0799cee..5a57174220 100644 --- a/core/memoize/memoize.factor +++ b/core/memoize/memoize.factor @@ -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? diff --git a/extra/monads/monads-tests.factor b/extra/monads/monads-tests.factor index a7b925ca2f..ca02097401 100644 --- a/extra/monads/monads-tests.factor +++ b/extra/monads/monads-tests.factor @@ -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, " ] + [ sqrt "took square root, " ] + [ 1 + "added one, " ] + [ 2 / "divided by two." ] + } do +] unit-test + { T{ identity f 7 } } [ 4 identity-monad return diff --git a/extra/monads/monads.factor b/extra/monads/monads.factor index 8ce4857088..20630aa15a 100644 --- a/extra/monads/monads.factor +++ b/extra/monads/monads.factor @@ -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 ] ; +M: writer >>= '[ [ _ run-writer ] dip '[ @ run-writer ] dip prepend ] ; : pass ( writer -- writer' ) run-writer [ first2 ] dip swap call( x -- y ) ; : listen ( writer -- writer' ) run-writer [ 2array ] keep ;