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