IN: inf355.cours2
USING: accessors arrays assocs combinators.smart continuations
destructors fry infix io kernel locals make math namespaces
sequences ;
! "call(" and "fry" illustration.
TUPLE: demo quot ;
: call-demo ( demo -- v )
quot>> call( -- x ) ;
: add-gen ( a b c -- quot )
[ [ + ] 2curry ]
[ [ - ] curry ] bi* compose ;
: add-gen2 ( a b c d -- quot )
'[ _ _ + _ @ ] ;
! Local variables and infix syntax. Most of the time, none of them is
! needed, but in some cases in may make the code clearer (e.g., when
! complex mathematical formulas are involved).
SYMBOL: myvar
:: delta ( a b c -- d )
b b * a c * 4 * - ;
:: delta2 ( a b c -- d )
[infix sq(b)-4*a*c infix] ;
:: delta3 ( a b c -- d )
a b c 3array :> tab
[infix sq(tab[1])-4*tab[0]*tab[2] infix] ;
:: example1 ( a b -- c d )
a b :> ( c d ) c d ;
: example2 ( a b -- c )
[let :> a :> b a b + ] ;
: example3 ( a b -- c )
[let :> a a + ] ;
: delta4 ( a b c -- d )
swapd [ sq ] [ 4 * ] [ * - ] tri* ;
! Destructors and object disposal. You can compare what happens when
! you raise an exception in "test-dispose" quotation.
TUPLE: myclass < disposable ;
M: myclass dispose*
drop "Object disposal" print ;
: test-dispose ( -- obj )
myclass new-disposable
[ |dispose "Code execution" print ] with-destructors
"End of code execution" print
;
! Let's implement Haskell like monads in Factor. Note for the readers:
! this has been done live in an interactive class session. This is
! probably not the best way to do it!
MIXIN: monad
! We use a "current-monad" variable to represent the context. It makes
! writing ">>=" easier since the monad won't be on the way to deeper
! stack values.
SYMBOL: current-monad
: with-monad ( monad quot -- monad )
[ current-monad ] dip [ current-monad get ] compose with-variable ; inline
! The three monadic operations we will use are "fail", "return" and
! ">>=" (bind). Those will call generic words that can be overriden
! for individual monad classes. The current monad isn't used for
! "fail*" and "return*" but is needed to get proper dispatching.
GENERIC: fail* ( monad -- monad )
GENERIC: return* ( data monad -- monad )
GENERIC# >>=* 1 ( monad quot -- monad )
! By default, we may want to have a defaut "fail" behaviour if "fail*" is
! not overriden. However, here we do not want it.
ERROR: failure ;
! M: monad fail* failure ;
: fail ( -- )
current-monad [ fail* ] change ;
: return ( data -- )
current-monad [ return* ] change ;
:: >>= ( quot -- )
current-monad [ quot >>=* ] change ;
! Data used for testing.
: telsdata ( -- hash )
H{ { "Sam" "0661" }
{ "Julien" "0991" } } ;
: tels ( name -- )
telsdata at [ return ] [ fail ] if* ;
! Implementation of the "maybe" tuple, corresponding to Haskell's maybe.
! Example use:
!
! ( scratchpad ) "Julien" just [ [ tels ] >>= [ "Phone number is " prepend return ] >>= ] with-monad .
! T{ maybe { set t } { data "Phone number is 0991" } }
!
! ( scratchpad ) nothing [ [ tels ] >>= [ "Phone number is " prepend return ] >>= ] with-monad .
! T{ maybe }
!
! ( scratchpad ) "Claire" just [ [ tels ] >>= [ "Phone number is " prepend return ] >>= ] with-monad .
! T{ maybe }
TUPLE: maybe
{ set boolean initial: f }
data ;
: just ( data -- maybe )
[ maybe new t >>set ] dip >>data ;
: nothing ( -- maybe )
maybe new ;
: from-maybe ( maybe -- data )
dup set>> t assert=
data>> ;
INSTANCE: maybe monad
M: maybe fail*
drop nothing ;
M: maybe return*
drop just ;
M: maybe >>=*
over set>>
[
[ from-maybe ] [ call( data -- ) ] bi* current-monad get
] [
drop
] if ;
! A sequence may be a monad. Example use with the very same code:
!
! ( scratchpad ) { "Julien" } [ [ tels ] >>= [ "Phone number is " prepend return ] >>= ] with-monad .
! { "Phone number is 0991" }
!
! ( scratchpad ) { "Claire" } [ [ tels ] >>= [ "Phone number is " prepend return ] >>= ] with-monad .
! { }
!
! ( scratchpad ) { "Julien" "Sam" } [ [ tels ] >>= [ "Phone number is " prepend return ] >>= ] with-monad .
! { "Phone number is 0991" "Phone number is 0661" }
INSTANCE: sequence monad
M: sequence fail*
{ } swap like ;
M: sequence return*
[ 1array ] [ like ] bi* ;
M: sequence >>=*
[ call( x -- ) current-monad get ] curry map concat ;
! We could also say that any object is a monad, with "f" representing a failure. For that to work
! properly and not interact with sequences, we need to either comment out the "sequence is a monad"
! section or specialize it for only some kind of sequences.
! INSTANCE: object monad
!
! M: object fail* drop f ;
!
! M: object return* drop ;
!
! M: object >>=*
! over [ call( x -- ) current-monad get ] [ drop ] if ;
! We can implement "do" which will bind every quotation in a sequence and return the result. Example use:
!
! ( scratchpad ) { "Julien" "Sam" } { [ tels ] [ "Phone number is " prepend return ] } do .
! { "Phone number is 0991" "Phone number is 0661" }
: do ( monad seq -- monad )
[ [ >>= ] each ] curry with-monad ;
! "do*" will also execute each quotation, and "fail" if an exception is raised or "return" it if it
! doesn't. Example use:
!
! ( scratchpad ) { 1 0 2 } { [ 1 swap / ] [ 2 + ] } do* .
! { 3 2+1/2 }
!
! ( scratchpad ) 1 just { [ 1 swap / ] [ 2 + ] } do* .
! T{ maybe { set t } { data 3 } }
!
! ( scratchpad ) 0 just { [ 1 swap / ] [ 2 + ] } do* .
! T{ maybe }
: do* ( monad seq -- monad )
[ '[ [ @ return ] [ 2drop fail ] recover ] ] map do ;