Update models to use inheritance instead of delegation

extra/models/compose/compose.factor

@@ -1,19 +1,24 @@
-USING: models kernel sequences ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors models kernel sequences ;
 IN: models.compose
 
-TUPLE: compose ;
+TUPLE: compose < model ;
+
+: new-compose ( models class -- compose )
+    f swap new-model
+        swap clone >>dependencies ; inline
 
 : <compose> ( models -- compose )
-    f compose construct-model
+    compose new-compose ;
-    swap clone over set-model-dependencies ;
 
-: composed-value >r model-dependencies r> map ; inline
+: composed-value [ dependencies>> ] dip map ; inline
 
-: set-composed-value >r model-dependencies r> 2each ; inline
+: set-composed-value [ dependencies>> ] dip 2each ; inline
 
 M: compose model-changed
     nip
-    dup [ model-value ] composed-value swap delegate set-model ;
+    [ [ model-value ] composed-value ] keep set-model ;
 
 M: compose model-activated dup model-changed ;
 

extra/models/delay/delay.factor

@@ -1,24 +1,26 @@
-USING: kernel models alarms ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel models alarms ;
 IN: models.delay
 
-TUPLE: delay model timeout alarm ;
+TUPLE: delay < model model timeout alarm ;
 
 : update-delay-model ( delay -- )
-    dup delay-model model-value swap set-model ;
+    [ delay-model model-value ] keep set-model ;
 
 : <delay> ( model timeout -- delay )
-    f delay construct-model
+    f delay new-model
-    [ set-delay-timeout ] keep
+        swap >>timeout
-    [ set-delay-model ] 2keep
+        over >>model
-    [ add-dependency ] keep ;
+        [ add-dependency ] keep ;
 
 : cancel-delay ( delay -- )
     delay-alarm [ cancel-alarm ] when* ;
 
 : start-delay ( delay -- )
-    dup [ f over set-delay-alarm update-delay-model ] curry
+    dup
-    over delay-timeout later
+    [ [ f >>alarm update-delay-model ] curry ] [ timeout>> ] bi later
-    swap set-delay-alarm ;
+    >>alarm drop ;
 
 M: delay model-changed nip dup cancel-delay start-delay ;
 

extra/models/filter/filter.factor

@@ -1,16 +1,17 @@
-USING: models kernel ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors models kernel ;
 IN: models.filter
 
-TUPLE: filter model quot ;
+TUPLE: filter < model model quot ;
 
 : <filter> ( model quot -- filter )
-    f filter construct-model
+    f filter new-model
-    [ set-filter-quot ] keep
+        swap >>quot
-    [ set-filter-model ] 2keep
+        over >>model
-    [ add-dependency ] keep ;
+        [ add-dependency ] keep ;
 
 M: filter model-changed
-    swap model-value over filter-quot call
+    [ [ value>> ] [ quot>> ] bi* call ] [ nip ] 2bi set-model ;
-    swap set-model ;
 
-M: filter model-activated dup filter-model swap model-changed ;
+M: filter model-activated [ model>> ] keep model-changed ;

extra/models/history/history.factor

@@ -1,14 +1,17 @@
-USING: kernel models sequences ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel models sequences ;
 IN: models.history
 
-TUPLE: history back forward ;
+TUPLE: history < model back forward ;
 
 : reset-history ( history -- )
-    V{ } clone over set-history-back
+    V{ } clone >>back
-    V{ } clone swap set-history-forward ;
+    V{ } clone >>forward ;
 
 : <history> ( value -- history )
-    history construct-model dup reset-history ;
+    history new-model
+        reset-history ;
 
 : (add-history) ( history to -- )
     swap model-value dup [ swap push ] [ 2drop ] if ;

extra/models/mapping/mapping.factor

@@ -1,20 +1,21 @@
-USING: models kernel assocs ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors models kernel assocs ;
 IN: models.mapping
 
-TUPLE: mapping assoc ;
+TUPLE: mapping < model assoc ;
 
 : <mapping> ( models -- mapping )
-    f mapping construct-model
+    f mapping new-model
-    over values over set-model-dependencies
+        over values >>dependencies
-    tuck set-mapping-assoc ;
+        swap >>assoc ;
 
 M: mapping model-changed
-    nip
+    nip [ assoc>> [ value>> ] assoc-map ] keep set-model ;
-    dup mapping-assoc [ model-value ] assoc-map
-    swap delegate set-model ;
 
-M: mapping model-activated dup model-changed ;
+M: mapping model-activated
+    dup model-changed ;
 
 M: mapping update-model
-    dup model-value swap mapping-assoc
+    [ value>> ] [ assoc>> ] bi
     [ swapd at set-model ] curry assoc-each ;

extra/models/models.factor

@@ -100,9 +100,6 @@ M: model update-model drop ;
 : (change-model) ( model quot -- )
     ((change-model)) set-model-value ; inline
 
-: construct-model ( value class -- instance )
-    >r <model> { set-delegate } r> construct ; inline
-
 GENERIC: range-value ( model -- value )
 GENERIC: range-page-value ( model -- value )
 GENERIC: range-min-value ( model -- value )

extra/models/range/range.factor

@@ -1,32 +1,33 @@
-USING: kernel models arrays sequences math math.order
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel models arrays sequences math math.order
 models.compose ;
 IN: models.range
 
-TUPLE: range ;
+TUPLE: range < compose ;
 
 : <range> ( value min max page -- range )
-    4array [ <model> ] map <compose>
+    4array [ <model> ] map range new-compose ;
-    { set-delegate } range construct ;
 
-: range-model ( range -- model ) model-dependencies first ;
+: range-model ( range -- model ) dependencies>> first ;
-: range-page ( range -- model ) model-dependencies second ;
+: range-page ( range -- model ) dependencies>> second ;
-: range-min ( range -- model ) model-dependencies third ;
+: range-min ( range -- model ) dependencies>> third ;
-: range-max ( range -- model ) model-dependencies fourth ;
+: range-max ( range -- model ) dependencies>> fourth ;
 
 M: range range-value
-    [ range-model model-value ] keep clamp-value ;
+    [ range-model value>> ] keep clamp-value ;
 
-M: range range-page-value range-page model-value ;
+M: range range-page-value range-page value>> ;
 
-M: range range-min-value range-min model-value ;
+M: range range-min-value range-min value>> ;
 
-M: range range-max-value range-max model-value ;
+M: range range-max-value range-max value>> ;
 
 M: range range-max-value*
-    dup range-max-value swap range-page-value [-] ;
+    [ range-max-value ] [ range-page-value ] bi [-] ;
 
 M: range set-range-value
-    [ clamp-value ] keep range-model set-model ;
+    [ clamp-value ] [ range-model ] bi set-model ;
 
 M: range set-range-page-value range-page set-model ;