]> gitweb.factorcode.org Git - factor.git/commitdiff
monads: Rename words to not be class/word
authorDoug Coleman <doug.coleman@gmail.com>
Sun, 24 Mar 2013 08:38:25 +0000 (01:38 -0700)
committerDoug Coleman <doug.coleman@gmail.com>
Sun, 24 Mar 2013 08:45:29 +0000 (01:45 -0700)
extra/monads/monads-tests.factor
extra/monads/monads.factor

index 5504633bb636fdac67bc5007f3c930467c142776..4c568f5f5f5d6c1962fdecdd9841e4e01b150116 100644 (file)
@@ -6,11 +6,11 @@ IN: monads.tests
 [ "OH HAI" identity-monad fail ] must-fail
 
 [ 666 ] [
-    111 just [ 6 * ] fmap [ ] [ "OOPS" throw ] if-maybe
+    111 <just> [ 6 * ] fmap [ ] [ "OOPS" throw ] if-maybe
 ] unit-test
 
 [ nothing ] [
-    111 just [ maybe-monad fail ] bind
+    111 <just> [ maybe-monad fail ] bind
 ] unit-test
 
 [ 100 ] [
@@ -70,10 +70,10 @@ IN: monads.tests
 
 [ nothing ] [
     {
-        [ "hi" just ]
-        [ " bye" append just ]
+        [ "hi" <just> ]
+        [ " bye" append <just> ]
         [ drop nothing ]
-        [ reverse just ]
+        [ reverse <just> ]
     } do
 ] unit-test
 
@@ -121,9 +121,9 @@ LAZY: nats-from ( n -- list )
 ] unit-test
 
 [ nothing ] [
-    5 just nothing maybe-monad apply
+    5 <just> nothing maybe-monad apply
 ] unit-test
 
 [ T{ just f 15 } ] [
-    5 just [ 10 + ] just maybe-monad apply
+    5 <just> [ 10 + ] <just> maybe-monad apply
 ] unit-test
index a859c36f2e22661c7c8b2dee311d7de787e43c00..73e2b98eb282c404d2c63ab4bbd1b5928eda0e09 100644 (file)
@@ -65,14 +65,14 @@ INSTANCE:  maybe-monad monad
 SINGLETON: nothing
 
 TUPLE: just value ;
-: just ( value -- just ) \ just boa ;
+C: <just> just
 
 UNION: maybe just nothing ;
 INSTANCE: maybe monad
 
 M: maybe monad-of drop maybe-monad ;
 
-M: maybe-monad return drop just ;
+M: maybe-monad return drop <just> ;
 M: maybe-monad fail   2drop nothing ;
 
 M: nothing >>= '[ drop _ ] ;
@@ -86,18 +86,18 @@ SINGLETON: either-monad
 INSTANCE:  either-monad monad
 
 TUPLE: left value ;
-: left ( value -- left ) \ left boa ;
+C: <left> left
 
 TUPLE: right value ;
-: right ( value -- right ) \ right boa ;
+C: <right> right
 
 UNION: either left right ;
 INSTANCE: either monad
 
 M: either monad-of drop either-monad ;
 
-M: either-monad return  drop right ;
-M: either-monad fail    drop left ;
+M: either-monad return  drop <right> ;
+M: either-monad fail    drop <left> ;
 
 M: left  >>= '[ drop _ ] ;
 M: right >>= value>> '[ _ swap call( x -- y ) ] ;
@@ -134,21 +134,21 @@ SINGLETON: state-monad
 INSTANCE:  state-monad monad
 
 TUPLE: state quot ;
-: state ( quot -- state ) \ state boa ;
+C: <state> state
 
 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 ( x state -- y ) quot>> call( x -- y ) ;
 
-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 ;
+: get-st ( -- state ) [ dup 2array ] <state> ;
+: put-st ( value -- state ) '[ drop _ f 2array ] <state> ;
 
 : run-st ( state initial -- value ) swap mcall second ;
 
@@ -159,37 +159,37 @@ SINGLETON: reader-monad
 INSTANCE:  reader-monad monad
 
 TUPLE: reader quot ;
-: reader ( quot -- reader ) \ reader boa ;
+C: <reader> reader
 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 -- value ) swap quot>> call( env -- value ) ;
 
-: ask ( -- reader ) [ ] reader ;
-: local ( reader quot -- reader' ) swap '[ @ _ mcall ] reader ;
+: ask ( -- reader ) [ ] <reader> ;
+: local ( reader quot -- reader' ) swap '[ @ _ mcall ] <reader> ;
 
 ! Writer
 SINGLETON: writer-monad
 INSTANCE:  writer-monad monad
 
 TUPLE: writer value log ;
-: writer ( value log -- writer ) \ writer boa ;
+C: <writer> writer
 
 M: writer monad-of drop writer-monad ;
 
-M: writer-monad return drop { } writer ;
+M: writer-monad return drop { } <writer> ;
 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( x -- y ) writer ;
-: listen ( writer -- writer' ) run-writer [ 2array ] keep writer ;
-: tell ( seq -- writer ) f swap writer ;
+: pass ( writer -- writer' ) run-writer [ first2 ] dip swap call( x -- y ) <writer> ;
+: listen ( writer -- writer' ) run-writer [ 2array ] keep <writer> ;
+: tell ( seq -- writer ) f swap <writer> ;