models.arrow: Add <?arrow> and <?smart-arrow>

Like `<arrow>` and `<smart-arrow>`, but using `?set-model` instead of `set-model`.

diff --git a/basis/models/arrow/arrow-docs.factor b/basis/models/arrow/arrow-docs.factor
index fd6ee2a0e29371f85efc8a361a6a7e6965250183..83c09ce099352b98322200d88eef48734d965dde 100644 (file)
--- a/basis/models/arrow/arrow-docs.factor
+++ b/basis/models/arrow/arrow-docs.factor
@@ -14,11 +14,19 @@ HELP: arrow
     "An exercise for the reader is to keep the original model around on the stack, and change its value to 6, observing that the label will immediately display 36."
 } ;
 
+HELP: ?arrow
+{ $class-description "Like " { $link arrow } ", but only updates value if it is different from the last update. Arrows are constructed by " { $link <?arrow> } "." } ;
+
 HELP: <arrow>
 { $values { "model" model } { "quot" { $quotation ( obj -- newobj ) } } { "arrow" "a new " { $link arrow } } }
 { $description "Creates a new instance of " { $link arrow } ". The value of the new arrow model is computed by applying the quotation to the value." }
 { $examples "See the example in the documentation for " { $link arrow } "." } ;
 
+HELP: <?arrow>
+{ $values { "model" model } { "quot" { $quotation ( obj -- newobj ) } } { "arrow" "a new " { $link ?arrow } } }
+{ $description "Creates a new instance of " { $link ?arrow } ". The value of the new arrow model is computed by applying the quotation to the value, but only set if the value actually changed. This prevents connected observers from being updated if the value did not change since the last update." }
+{ $examples "See the example in the documentation for " { $link arrow } "." } ;
+
 ARTICLE: "models.arrow" "Arrow models"
 "Arrow model values are computed by applying a quotation to the value of another model."
 { $subsections

diff --git a/basis/models/arrow/arrow.factor b/basis/models/arrow/arrow.factor
index 24797a1cbf66a120e77eb0b942907de9a8ed0569..809704e83e079245531993451a2196821138319e 100644 (file)
--- a/basis/models/arrow/arrow.factor
+++ b/basis/models/arrow/arrow.factor
@@ -5,14 +5,27 @@ IN: models.arrow
 
 TUPLE: arrow < model quot ;
 
-: <arrow> ( model quot -- arrow )
-    f arrow new-model
-        swap >>quot
+: new-arrow ( model quot class -- arrow )
+    f swap new-model
+    swap >>quot
     [ add-dependency ] keep ;
 
+: <arrow> ( model quot -- arrow )
+    arrow new-arrow ;
+
+: compute-arrow-value ( model observer -- value )
+    [ value>> ] [ quot>> ] bi* call( old -- new ) ; inline
+
 M: arrow model-changed
-    [ [ value>> ] [ quot>> ] bi* call( old -- new ) ]
-    [ set-model ] bi ;
+    [ compute-arrow-value ] [ set-model ] bi ;
 
 M: arrow model-activated
     [ dependencies>> ] keep [ model-changed ] curry each ;
+
+TUPLE: ?arrow < arrow ;
+
+: <?arrow> ( model quot -- ?arrow )
+    ?arrow new-arrow ;
+
+M: ?arrow model-changed
+    [ compute-arrow-value ] [ ?set-model ] bi ;

diff --git a/basis/models/arrow/smart/smart-docs.factor b/basis/models/arrow/smart/smart-docs.factor
index 22f14c9fdc995b880e04532d417c255e90ca2d09..3dffa607b5f1564dddf71531912dc3b21acc82f3 100644 (file)
--- a/basis/models/arrow/smart/smart-docs.factor
+++ b/basis/models/arrow/smart/smart-docs.factor
@@ -1,5 +1,5 @@
 IN: models.arrow.smart
-USING: help.syntax help.markup models.product ;
+USING: help.syntax help.markup models.product models.arrow ;
 
 HELP: <smart-arrow>
 { $values { "quot" { $quotation ( ... -- output ) } } }
@@ -14,6 +14,10 @@ HELP: <smart-arrow>
   }
 } ;
 
+HELP: <?smart-arrow>
+{ $values { "quot" { $quotation ( ... -- output ) } } }
+{ $description "Like " { $link <smart-arrow> } ", but with the semantics of " { $link <?arrow> } "." } ;
+
 ARTICLE: "models.arrow.smart" "Smart arrow models"
 "The " { $vocab-link "models.arrow.smart" } " vocabulary generalizes arrows to arbitrary input arity. They're called “smart” because they resemble " { $link "combinators.smart" } "."
 { $subsections <smart-arrow> } ;

diff --git a/basis/models/arrow/smart/smart.factor b/basis/models/arrow/smart/smart.factor
index c14d2039dbe8583ece2dcc96496e1b8eda67e4af..3a9aa2aa2416d5903146fca312a090fed93158b0 100644 (file)
--- a/basis/models/arrow/smart/smart.factor
+++ b/basis/models/arrow/smart/smart.factor
@@ -8,3 +8,7 @@ IN: models.arrow.smart
 MACRO: <smart-arrow> ( quot -- quot' )
     [ inputs dup ] keep
     '[ _ narray <product> [ _ firstn @ ] <arrow> ] ;
+
+MACRO: <?smart-arrow> ( quot -- quot' )
+    [ inputs dup ] keep
+    '[ _ narray <product> [ _ firstn @ ] <?arrow> ] ;