M: identity-monad return drop identity boa ;
M: identity-monad fail "Fail" throw ;
-M: identity >>= value>> '[ , _ call ] ;
+M: identity >>= value>> '[ , swap call ] ;
: run-identity ( identity -- value ) value>> ;
M: maybe-monad fail 2drop nothing ;
M: nothing >>= '[ drop , ] ;
-M: just >>= value>> '[ , _ call ] ;
+M: just >>= value>> '[ , swap call ] ;
: if-maybe ( maybe just-quot nothing-quot -- )
pick nothing? [ 2nip call ] [ drop [ value>> ] dip call ] if ; inline
M: either-monad fail drop left ;
M: left >>= '[ drop , ] ;
-M: right >>= value>> '[ , _ call ] ;
+M: right >>= value>> '[ , swap call ] ;
: if-either ( value left-quot right-quot -- )
[ [ value>> ] [ left? ] bi ] 2dip if ; inline
M: array monad-of drop array-monad ;
-M: array >>= '[ , _ map concat ] ;
+M: array >>= '[ , swap map concat ] ;
! List
SINGLETON: list-monad
M: list monad-of drop list-monad ;
-M: list >>= '[ , _ lazy-map lconcat ] ;
+M: list >>= '[ , swap lazy-map lconcat ] ;
! State
SINGLETON: state-monad
: mcall ( state -- ) quot>> call ;
-M: state >>= '[ , _ '[ , mcall first2 @ mcall ] state ] ;
+M: state >>= '[ , swap '[ , mcall first2 @ mcall ] state ] ;
: get-st ( -- state ) [ dup 2array ] state ;
: put-st ( value -- state ) '[ drop , f 2array ] state ;
M: reader-monad return drop '[ drop , ] reader ;
M: reader-monad fail "Fail" throw ;
-M: reader >>= '[ , _ '[ dup , mcall @ mcall ] reader ] ;
+M: reader >>= '[ , swap '[ dup , mcall @ mcall ] reader ] ;
: run-reader ( reader env -- ) swap mcall ;
: run-writer ( writer -- value log ) [ value>> ] [ log>> ] bi ;
-M: writer >>= '[ , run-writer _ '[ @ run-writer ] dip append writer ] ;
+M: writer >>= '[ [ , run-writer ] dip '[ @ run-writer ] dip append writer ] ;
: pass ( writer -- writer' ) run-writer [ first2 ] dip swap call writer ;
: listen ( writer -- writer' ) run-writer [ 2array ] keep writer ;