tuple-slots word

diff --git a/contrib/calendar/calendar.factor b/contrib/calendar/calendar.factor
index 70415eb1b59c162eea290821a936afd96219d263..3679bb43476ec7c9286f89ff3e6c21dc1a4755a0 100644 (file)
--- a/contrib/calendar/calendar.factor
+++ b/contrib/calendar/calendar.factor
@@ -29,10 +29,8 @@ TUPLE: dt year month day hour minute second ;
     #! length of average month in days
     30.41666666666667 ;
 
-: time>array ( dt -- vec ) tuple>array 2 tail ;
-
 : compare-timestamps ( tuple tuple -- n )
-    [ time>array ] 2apply <=> ;
+    [ tuple-slots ] 2apply <=> ;
 
 SYMBOL: a
 SYMBOL: b
@@ -173,12 +171,12 @@ M: number +second ( timestamp n -- timestamp )
     [ = [ "invalid timestamp" throw ] unless ] keep ;
 
 : array>dt ( vec -- dt ) { dt f } swap append >tuple ;
-: +dts ( dt dt -- dt ) [ time>array ] 2apply v+ array>dt ;
+: +dts ( dt dt -- dt ) [ tuple-slots ] 2apply v+ array>dt ;
 
 : dt>years ( dt -- x )
     #! Uses average month/year length since dt loses calendar
     #! data
-    time>array
+    tuple-slots
     { 1 12 365.2425 8765.82 525949.2 31556952.0 }
     [ / ] 2map sum ;
 : dt>months ( dt -- x ) dt>years 12 * ;
@@ -208,10 +206,10 @@ M: number +second ( timestamp n -- timestamp )
     unix-1970 millis 1000 /f seconds +dt ; 
 
 : timestamp- ( timestamp timestamp -- dt )
-    [ >gmt time>array ] 2apply v- array>dt ;
+    [ >gmt tuple-slots ] 2apply v- array>dt ;
 
 : now ( -- timestamp ) gmt >local-time ;
-: before ( dt -- -dt ) time>array [ neg ] map array>dt ;
+: before ( dt -- -dt ) tuple-slots [ neg ] map array>dt ;
 : from-now ( dt -- timestamp ) now swap +dt ;
 : ago ( dt -- timestamp ) before from-now ;
 

diff --git a/contrib/furnace/responder.factor b/contrib/furnace/responder.factor
index 43d11ae46b4749525d3593918ee3f0b72caf038d..44ec893e0657eb595d9aeadde10bc71f0172b43e 100644 (file)
--- a/contrib/furnace/responder.factor
+++ b/contrib/furnace/responder.factor
@@ -87,7 +87,7 @@ SYMBOL: request-params
 : service-post ( url -- ) "response" get swap service-request ;
 
 : explode-tuple ( tuple -- )
-    dup tuple>array 2 tail swap class "slot-names" word-prop
+    dup tuple-slots swap class "slot-names" word-prop
     [ set ] 2each ;
 
 SYMBOL: model

diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor
index 3d934e320d841a9dd7efb9872556f72f095eded0..9ffbb201e9f522ef566921c5ffad6a4be248aa90 100644 (file)
--- a/library/generic/tuple.factor
+++ b/library/generic/tuple.factor
@@ -45,7 +45,7 @@ IN: generic
 
 : delegate-slots { { 3 object delegate set-delegate } } ;
 
-: tuple-slots ( class slots -- )
+: define-tuple-slots ( class slots -- )
     2dup "slot-names" set-word-prop
     2dup length 2 + "tuple-size" set-word-prop
     dupd 4 simple-slots
@@ -80,7 +80,7 @@ TUPLE: check-tuple class ;
     dup tuple-predicate
     dup \ tuple bootstrap-word "superclass" set-word-prop
     dup define-class
-    dup r> tuple-slots
+    dup r> define-tuple-slots
     default-constructor ;
 
 M: tuple clone
@@ -106,6 +106,8 @@ GENERIC: tuple>array ( tuple -- array )
 
 M: tuple tuple>array (clone) array-type become ;
 
+: tuple-slots ( tuple -- seq ) tuple>array 2 tail ;
+
 ! Definition protocol
 M: tuple-class forget
     dup "constructor" word-prop forget forget-class ;