steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

monads: fix ordering of writer monad logs.

clean-macosx-x86-64
John Benediktsson 2019-09-29 07:15:28 -07:00
parent 17a0a6e1a4
commit 9a8b1f8d8e
2 changed files with 19 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
extra/monads/monads-tests.factor
View File

@ -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 ; FROM: monads => do ;
IN: monads.tests IN: monads.tests
@ -113,6 +114,22 @@ LAZY: nats-from ( n -- list )
run-writer run-writer
] unit-test ] 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 } } { T{ identity f 7 } }
[ [
4 identity-monad return 4 identity-monad return

2
extra/monads/monads.factor
View File

@ -188,7 +188,7 @@ M: writer-monad fail "Fail" throw ;
: run-writer ( writer -- value log ) [ value>> ] [ log>> ] bi ; : 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> ; : pass ( writer -- writer' ) run-writer [ first2 ] dip swap call( x -- y ) <writer> ;
: listen ( writer -- writer' ) run-writer [ 2array ] keep <writer> ; : listen ( writer -- writer' ) run-writer [ 2array ] keep <writer> ;