]> gitweb.factorcode.org Git - factor.git/commitdiff
Revert "calendar: make now faster, remove now-gmt."
authorJohn Benediktsson <mrjbq7@gmail.com>
Fri, 11 Dec 2020 06:26:20 +0000 (22:26 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Fri, 11 Dec 2020 06:26:20 +0000 (22:26 -0800)
This reverts commit 2b025836055ee7a59a8b3d7cb8946c7ed0a050f0.

basis/calendar/calendar-docs.factor
basis/calendar/calendar.factor
basis/calendar/unix/unix.factor
basis/calendar/windows/windows.factor
basis/furnace/cache/cache.factor
basis/smtp/smtp.factor
basis/uuid/uuid.factor
extra/ci/run-process/run-process.factor
extra/key-logger/key-logger.factor
extra/managed-server/chat/chat.factor
extra/webapps/irc-log/irc-log.factor

index 74a06717f1638657bd5c469b6b8cdcb79998b726..e05b3654f785df7d660a0dea5ad6c3c4c1036b3d 100644 (file)
@@ -154,8 +154,6 @@ HELP: time+
     }
 } ;
 
-{ time+ time- } related-words
-
 HELP: duration>years
 { $values { "duration" duration } { "x" number } }
 { $description "Calculates the length of a duration in years." }
@@ -266,7 +264,7 @@ HELP: convert-timezone
 { $description "Converts the " { $snippet "timestamp" } "'s " { $snippet "gmt-offset" } " to the GMT offset represented by the " { $snippet "duration" } "." }
 { $examples
     { $example "USING: accessors calendar prettyprint ;"
-               "now >gmt noon -5 hours convert-timezone gmt-offset>> hour>> ."
+               "now-gmt noon instant -5 >>hour convert-timezone gmt-offset>> hour>> ."
                "-5"
     }
 } ;
@@ -276,7 +274,7 @@ HELP: >local-time
 { $description "Converts the " { $snippet "timestamp" } " to the timezone of your computer." }
 { $examples
     { $example "USING: accessors calendar kernel prettyprint ;"
-               "now dup clone >gmt >local-time [ gmt-offset>> ] same? ."
+               "now now-gmt >local-time [ gmt-offset>> ] same? ."
                "t"
     }
 } ;
@@ -303,9 +301,10 @@ HELP: gmt
 
 { local-time >local-time gmt >gmt convert-timezone } related-words
 
-HELP: duration*
+HELP: time*
 { $values { "obj1" object } { "obj2" object } { "obj3" object } }
-{ $description "Multiplies each time slot of a duration by a number and make a new duration from the result. Used in the implementation of " { $link before } "." } ;
+{ $description "Multiplies each time slot of a timestamp or duration by a number and make a new duration from the result. Used in the implementation of " { $link before } "." } ;
+{ time+ time- time* } related-words
 
 HELP: before
 { $values { "duration" duration } { "-duration" duration } }
@@ -331,6 +330,12 @@ HELP: micros>timestamp
     }
 } ;
 
+HELP: now-gmt
+{ $values { "timestamp" timestamp } }
+{ $description "Returns the time right now, but in the GMT timezone." } ;
+
+{ now now-gmt } related-words
+
 HELP: now
 { $values { "timestamp" timestamp } }
 { $description "Returns the time right now in your computer's timezone." }
@@ -527,8 +532,8 @@ ARTICLE: "timestamp-arithmetic" "Timestamp arithmetic"
 { $subsections time+ }
 "Subtracting:"
 { $subsections time- }
-"Multiplying durations:"
-{ $subsections duration* } ;
+"Element-wise multiplication:"
+{ $subsections time* } ;
 
 ARTICLE: "using-durations" "Using durations"
 "Creating a duration object:"
index f9fa3a08af6a53c262820947dd6d0075cc10d605..a95baf990ec0c2711e80b28b0d95457824132e08 100644 (file)
@@ -15,7 +15,7 @@ ERROR: not-in-interval value interval ;
 
 HOOK: gmt-offset os ( -- hours minutes seconds )
 
-HOOK: now os ( -- timestamp )
+HOOK: now-gmt os ( -- timestamp )
 
 TUPLE: duration
     { year real }
@@ -448,6 +448,9 @@ M: duration time-
 : timestamp>micros ( timestamp -- n )
     unix-1970 (time-) 1000000 * >integer ;
 
+: now ( -- timestamp )
+    now-gmt gmt-offset-duration [ (time+) ] [ >>gmt-offset ] bi ;
+
 : hence ( duration -- timestamp ) now swap time+ ;
 : ago ( duration -- timestamp ) now swap time- ;
 
index cb850f8e43816ed89559014dde0cf18abb703c3b..3fbe252511a474a8a728d8c596e298bfef3ca18f 100644 (file)
@@ -14,7 +14,7 @@ IN: calendar.unix
     timeval>seconds seconds ; inline
 
 : timeval>unix-time ( timeval -- timestamp )
-    unix-1970 swap timeval>seconds +second ; inline
+    [ unix-1970 ] dip timeval>seconds +second ; inline
 
 : timespec>seconds ( timespec -- seconds )
     [ sec>> ] [ nsec>> 1,000,000,000 / ] bi + ; inline
@@ -23,7 +23,7 @@ IN: calendar.unix
     timespec>seconds seconds ; inline
 
 : timespec>unix-time ( timespec -- timestamp )
-    unix-1970 swap timespec>seconds +second ; inline
+    [ unix-1970 ] dip timespec>seconds +second ; inline
 
 : get-time ( -- alien )
     f time time_t <ref> localtime ; inline
@@ -40,8 +40,5 @@ M: unix gmt-offset
 : system-micros ( -- n )
     current-timeval timeval>micros ;
 
-M: unix now
-    timeval <struct> timezone <struct>
-    [ gettimeofday io-error ] 2keep
-    [ timeval>unix-time dup gmt-offset>> ]
-    [ tz_minuteswest>> 60 /mod [ >>hour ] [ >>minute ] bi* drop ] bi* ;
+M: unix now-gmt
+    current-timeval timeval>unix-time ;
index 82e50786cadd0523551d43dc8b070ee063bffc31..dea9f7257ea2b3cfd08260cf87ae52cf8fe39033 100644 (file)
@@ -37,6 +37,5 @@ M: windows gmt-offset
         { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] }
     } case neg 60 /mod 0 ;
 
-M: windows now
-    SYSTEMTIME <struct> [ GetSystemTime ] keep SYSTEMTIME>timestamp
-    dup gmt-offset>> gmt-offset set-time drop ;
+M: windows now-gmt
+    SYSTEMTIME <struct> [ GetSystemTime ] keep SYSTEMTIME>timestamp ;
index aaad309656abc3dbdf74a40607ec377b23388e80..a43f74ffab7cef11d17e673442b92e27e1d0778b 100644 (file)
@@ -22,7 +22,7 @@ server-state f
 
 : expire-state ( class -- )
     new
-        -1/0. now timestamp>micros [a,b] >>expires
+        -1/0. now-gmt timestamp>micros [a,b] >>expires
     delete-tuples ;
 
 TUPLE: server-state-manager < filter-responder timeout ;
index 744796bb44827207db824cbbe9033e0deb43cb26..5690545268eb9dbbb081aa572d0d20f67b1aee90 100644 (file)
@@ -193,7 +193,7 @@ ERROR: invalid-header-string string ;
         "<" %
         64 random-bits #
         "-" %
-        now timestamp>micros #
+        now-gmt timestamp>micros #
         "@" %
         smtp-config get domain>> [ host-name ] unless* %
         ">" %
index b96434627b6f4ad3bbb959028ebd6576b8ed59ab..5c34a8c8c65b65120fa287c7b280323c05fa2a3d 100644 (file)
@@ -11,7 +11,7 @@ IN: uuid
     ! 0x01b21dd213814000L is the number of 100-ns intervals
     ! between the UUID epoch 1582-10-15 00:00:00 and the
     ! Unix epoch 1970-01-01 00:00:00.
-    now timestamp>micros 10 * 0x01b21dd213814000 +
+    now-gmt timestamp>micros 10 * 0x01b21dd213814000 +
     [ -48 shift 0x0fff bitand ]
     [ -32 shift 0xffff bitand ]
     [ 0xffffffff bitand ]
index 96fc0f9c260c331e996dc16d41037c2ba87fcf0f..67c2693e1ea1fe187e96ba7d80a19868412f25bf 100644 (file)
@@ -13,7 +13,7 @@ TUPLE: process-autopsy
 : ci-run-process ( process -- timestamp os-envs cwd uid euid gid egid out elapsed os-envs' process )
     [
         [
-            now os-envs current-directory get
+            now-gmt os-envs current-directory get
             real-user-id effective-user-id
             real-group-id effective-group-id
         ] dip [
index 75a1f0e7178679e14d587765ba2a1275a1fa7cf9..c4b48a2de33a7c7a3c33b3e8c9847b9dddceb6b1 100644 (file)
@@ -12,7 +12,7 @@ CONSTANT: path "resource:key-log.txt"
 : update-key-caps-state ( -- )
     read-keyboard keys>>
     path binary [
-        [ now unix-1970 time- duration>nanoseconds >integer ]
+        [ now-gmt unix-1970 time- duration>nanoseconds >integer ]
         [ bit-array>integer ] bi*
         [ 8 >be write ] bi@ flush
     ] with-file-appender ;
index e23a1934af8a21988e6943961f51c4008cecc617..c425890c402bc05e8a921798157ea8763fd70793 100644 (file)
@@ -76,7 +76,7 @@ Displays the documentation for a command."
 Shows the list of connected users."
 "who" add-command
 
-[ drop now >gmt timestamp>rfc822 send-line ]
+[ drop now-gmt timestamp>rfc822 send-line ]
 "Syntax: /time
 Returns the current GMT time." "time" add-command
 
index 5158c9afd04d479dd3c6ac2b97774c9650a56c6c..74805f91e860b11ec0920eeea7f74fc9cec23eeb 100644 (file)
@@ -8,7 +8,7 @@ IN: webapps.irc-log
 TUPLE: irclog-app < dispatcher ;
 
 : irc-link ( channel -- string )
-    now -7 hours convert-timezone >date<
+    now-gmt -7 hours convert-timezone >date<
     [ unparse 2 tail ] 2dip
     "http://bespin.org/~nef/logs/%s/%02s.%02d.%02d"
     sprintf ;