"<$" made generic + moved to monads

db4
Sam Anklesaria 2009-06-27 13:31:22 -05:00
parent 07c8c00a12
commit 721a6dc3ab
5 changed files with 6 additions and 5 deletions

View File

@ -7,6 +7,7 @@ IN: monads
! Functors
GENERIC# fmap 1 ( functor quot -- functor' )
GENERIC# <$ 1 ( functor quot -- functor' )
! Monads

View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax ui.frp.signals ui.frp.signals.private ;
USING: help.markup help.syntax ui.frp.signals ;
IN: ui.frp.functors
ARTICLE: { "ui.frp.functors" "signal-collection" } "Signal Collection"

View File

@ -1,7 +1,7 @@
USING: accessors arrays fry kernel lexer make math.parser
models monads namespaces parser sequences
sequences.extras ui.frp.gadgets ui.frp.signals ui.gadgets
ui.gadgets.books ui.gadgets.tracks words ui.tools.inspector ;
ui.gadgets.books ui.gadgets.tracks words ;
QUALIFIED: make
IN: ui.frp.layout
@ -62,7 +62,7 @@ GENERIC# (insert-item) 1 ( item location -- )
M: gadget (insert-item) dup parent>> track? [ [ f <layout> ] dip (insert-item) ]
[ insertion-point [ add-gadget ] keep insert-gadget ] if ;
M: layout (insert-item) insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
M: model (insert-item) dup inspector parent>> dup book? [ "No models in books" throw ]
M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
[ dup model>> dup |? [ nip swap add-connection ] [ drop [ 1array <|> ] dip (>>model) ] if ] if ;
: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
[ add-member ] 2keep (insert-item) ;

View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax models models.arrow sequences ui.frp.signals ;
USING: help.markup help.syntax models models.arrow sequences ui.frp.signals monads ;
IN: ui.frp.signals
HELP: <merge>

View File

@ -78,7 +78,7 @@ M: side-effect-model (model-changed) [ value>> ] dip [ quot>> call( old -- ) ] 2
TUPLE: quot-model < mapped-model ;
M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
: <$ ( model quot -- signal ) quot-model new-mapped-model ;
M: model <$ quot-model new-mapped-model ;
TUPLE: action-value < basic-model parent ;
: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;