X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=extra%2Fmonads%2Fmonads.factor;fp=extra%2Fmonads%2Fmonads.factor;h=e9ae1675323d53170bb47ccdd76739088b60c76e;hp=bff720b2a36b506bcb5bc5d15f1bacbcb53cbf2e;hb=cf80dd122adf3e0ec3fa423823f16d13679399b5;hpb=83aa1ccb68bf411f22c69147eebef187c42d705e

diff --git a/extra/monads/monads.factor b/extra/monads/monads.factor
index bff720b2a3..e9ae167532 100644
--- a/extra/monads/monads.factor
+++ b/extra/monads/monads.factor
@@ -22,7 +22,7 @@ M: monad return monad-of return ;
 M: monad fail   monad-of fail   ;
 
 : bind ( mvalue quot -- mvalue' ) swap >>= call ;
-: >>   ( mvalue k -- mvalue' ) '[ drop , ] bind ;
+: >>   ( mvalue k -- mvalue' ) '[ drop _ ] bind ;
 
 :: lift-m2 ( m1 m2 f monad -- m3 )
     m1 [| x1 | m2 [| x2 | x1 x2 f monad return ] bind ] bind ;
@@ -34,7 +34,7 @@ M: monad fail   monad-of fail   ;
         ] bind
     ] bind ;
 
-M: monad fmap over '[ @ , return ] bind ;
+M: monad fmap over '[ @ _ return ] bind ;
 
 ! 'do' notation
 : do ( quots -- result ) unclip dip [ bind ] each ;
@@ -51,7 +51,7 @@ M: identity monad-of drop identity-monad ;
 M: identity-monad return drop identity boa ;
 M: identity-monad fail   "Fail" throw ;
 
-M: identity >>= value>> '[ , swap call ] ;
+M: identity >>= value>> '[ _ swap call ] ;
 
 : run-identity ( identity -- value ) value>> ;
 
@@ -72,8 +72,8 @@ M: maybe monad-of drop maybe-monad ;
 M: maybe-monad return drop just ;
 M: maybe-monad fail   2drop nothing ;
 
-M: nothing >>= '[ drop , ] ;
-M: just    >>= value>> '[ , swap call ] ;
+M: nothing >>= '[ drop _ ] ;
+M: just    >>= value>> '[ _ swap call ] ;
 
 : if-maybe ( maybe just-quot nothing-quot -- )
     pick nothing? [ 2nip call ] [ drop [ value>> ] dip call ] if ; inline
@@ -96,8 +96,8 @@ M: either monad-of drop either-monad ;
 M: either-monad return  drop right ;
 M: either-monad fail    drop left ;
 
-M: left  >>= '[ drop , ] ;
-M: right >>= value>> '[ , swap call ] ;
+M: left  >>= '[ drop _ ] ;
+M: right >>= value>> '[ _ swap call ] ;
 
 : if-either ( value left-quot right-quot -- )
     [ [ value>> ] [ left? ] bi ] 2dip if ; inline
@@ -112,7 +112,7 @@ M: array-monad fail   2drop { } ;
 
 M: array monad-of drop array-monad ;
 
-M: array >>= '[ , swap map concat ] ;
+M: array >>= '[ _ swap map concat ] ;
 
 ! List
 SINGLETON: list-monad
@@ -124,7 +124,7 @@ M: list-monad fail   2drop nil ;
 
 M: list monad-of drop list-monad ;
 
-M: list >>= '[ , swap lazy-map lconcat ] ;
+M: list >>= '[ _ swap lazy-map lconcat ] ;
 
 ! State
 SINGLETON: state-monad
@@ -137,15 +137,15 @@ INSTANCE: state monad
 
 M: state monad-of drop state-monad ;
 
-M: state-monad return drop '[ , 2array ] state ;
+M: state-monad return drop '[ _ 2array ] state ;
 M: state-monad fail   "Fail" throw ;
 
 : mcall ( state -- ) quot>> call ;
 
-M: state >>= '[ , swap '[ , 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 ;
+: put-st ( value -- state ) '[ drop _ f 2array ] state ;
 
 : run-st ( state initial -- ) swap mcall second ;
 
@@ -161,15 +161,15 @@ INSTANCE: reader monad
 
 M: reader monad-of drop reader-monad ;
 
-M: reader-monad return drop '[ drop , ] reader ;
+M: reader-monad return drop '[ drop _ ] reader ;
 M: reader-monad fail   "Fail" throw ;
 
-M: reader >>= '[ , swap '[ dup , mcall @ mcall ] reader ] ;
+M: reader >>= '[ _ swap '[ dup _ mcall @ mcall ] reader ] ;
 
 : run-reader ( reader env -- ) swap mcall ;
 
 : ask ( -- reader ) [ ] reader ;
-: local ( reader quot -- reader' ) swap '[ @ , mcall ] reader ;
+: local ( reader quot -- reader' ) swap '[ @ _ mcall ] reader ;
 
 ! Writer
 SINGLETON: writer-monad
@@ -185,7 +185,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 append writer ] ;
 
 : pass ( writer -- writer' ) run-writer [ first2 ] dip swap call writer ;
 : listen ( writer -- writer' ) run-writer [ 2array ] keep writer ;