From 4b1690b9c1547e1cd22623d79b87cc920bc61ee4 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 29 Nov 2014 23:00:24 -0800
Subject: [PATCH] models: some more cleanup.

---
 basis/models/arrow/arrow.factor       |  8 ++++----
 basis/models/product/product.factor   |  4 ++--
 extra/models/history/history.factor   | 12 +++++++-----
 extra/models/illusion/illusion.factor | 14 +++++++++-----
 4 files changed, 22 insertions(+), 16 deletions(-)

diff --git a/basis/models/arrow/arrow.factor b/basis/models/arrow/arrow.factor
index a1654ccc34..2ed0e9fea0 100644
--- a/basis/models/arrow/arrow.factor
+++ b/basis/models/arrow/arrow.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors models kernel sequences ;
+USING: accessors kernel models sequences ;
 IN: models.arrow
 
 TUPLE: arrow < model quot ;
@@ -8,11 +8,11 @@ TUPLE: arrow < model quot ;
 : <arrow> ( model quot -- arrow )
     f arrow new-model
         swap >>quot
-        [ add-dependency ] keep ;
+    [ add-dependency ] keep ;
 
 M: arrow model-changed
-    [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
-    set-model ;
+    [ [ value>> ] [ quot>> ] bi* call( old -- new ) ]
+    [ set-model ] bi ;
 
 M: arrow model-activated
     [ dependencies>> ] keep [ model-changed ] curry each ;
diff --git a/basis/models/product/product.factor b/basis/models/product/product.factor
index efce437ffd..04e06cb55a 100644
--- a/basis/models/product/product.factor
+++ b/basis/models/product/product.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors models kernel sequences ;
+USING: accessors kernel models sequences ;
 IN: models.product
 
 TUPLE: product < model ;
@@ -26,7 +26,7 @@ M: product model-changed
 M: product model-activated dup model-changed ;
 
 M: product update-model
-    dup value>> swap [ set-model ] set-product-value ;
+    [ value>> ] keep [ set-model ] set-product-value ;
 
 M: product range-value
     [ range-value ] product-value ;
diff --git a/extra/models/history/history.factor b/extra/models/history/history.factor
index 90d6b594ff..58cd6e0bca 100644
--- a/extra/models/history/history.factor
+++ b/extra/models/history/history.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel models sequences ;
+USING: accessors kernel locals models sequences ;
 IN: models.history
 
 TUPLE: history < model back forward ;
@@ -14,11 +14,13 @@ TUPLE: history < model back forward ;
         reset-history ;
 
 : (add-history) ( history to -- )
-    swap value>> dup [ swap push ] [ 2drop ] if ;
+    swap value>> [ swap push ] [ drop ] if* ;
 
-: go-back/forward ( history to from -- )
-    [ 2drop ]
-    [ [ dupd (add-history) ] dip pop swap set-model ] if-empty ;
+:: go-back/forward ( history to from -- )
+    from empty? [
+        history to (add-history)
+        from pop history set-model
+    ] unless ;
 
 : go-back ( history -- )
     dup [ forward>> ] [ back>> ] bi go-back/forward ;
diff --git a/extra/models/illusion/illusion.factor b/extra/models/illusion/illusion.factor
index 00169792a9..27cee7d13b 100644
--- a/extra/models/illusion/illusion.factor
+++ b/extra/models/illusion/illusion.factor
@@ -1,15 +1,19 @@
-USING: accessors models models.arrow inverse kernel ;
+USING: accessors inverse kernel models models.arrow ;
 IN: models.illusion
 
 TUPLE: illusion < arrow ;
 
 : <illusion> ( model quot -- illusion )
-    illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref
-    swap >>quot over >>model [ add-dependency ] keep ;
+    f illusion new-model
+        swap >>quot
+        over >>model
+    [ add-dependency ] keep ;
 
-: <activated-illusion> ( model quot -- illusion ) <illusion> dup activate-model ;
+: <activated-illusion> ( model quot -- illusion )
+    <illusion> dup activate-model ;
 
 : backtalk ( value object -- )
    [ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ;
 
-M: illusion update-model ( model -- ) [ [ value>> ] keep backtalk ] with-locked-model ;
\ No newline at end of file
+M: illusion update-model ( model -- )
+    [ [ value>> ] keep backtalk ] with-locked-model ;