]> gitweb.factorcode.org Git - factor.git/commitdiff
calendar: make now faster, remove now-gmt.
authorJohn Benediktsson <mrjbq7@gmail.com>
Fri, 11 Dec 2020 06:23:47 +0000 (22:23 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Fri, 11 Dec 2020 06:23:47 +0000 (22:23 -0800)
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 e05b3654f785df7d660a0dea5ad6c3c4c1036b3d..74a06717f1638657bd5c469b6b8cdcb79998b726 100644 (file)
@@ -154,6 +154,8 @@ HELP: time+
     }
 } ;
 
+{ time+ time- } related-words
+
 HELP: duration>years
 { $values { "duration" duration } { "x" number } }
 { $description "Calculates the length of a duration in years." }
@@ -264,7 +266,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 instant -5 >>hour convert-timezone gmt-offset>> hour>> ."
+               "now >gmt noon -5 hours convert-timezone gmt-offset>> hour>> ."
                "-5"
     }
 } ;
@@ -274,7 +276,7 @@ HELP: >local-time
 { $description "Converts the " { $snippet "timestamp" } " to the timezone of your computer." }
 { $examples
     { $example "USING: accessors calendar kernel prettyprint ;"
-               "now now-gmt >local-time [ gmt-offset>> ] same? ."
+               "now dup clone >gmt >local-time [ gmt-offset>> ] same? ."
                "t"
     }
 } ;
@@ -301,10 +303,9 @@ HELP: gmt
 
 { local-time >local-time gmt >gmt convert-timezone } related-words
 
-HELP: time*
+HELP: duration*
 { $values { "obj1" object } { "obj2" object } { "obj3" object } }
-{ $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
+{ $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 } "." } ;
 
 HELP: before
 { $values { "duration" duration } { "-duration" duration } }
@@ -330,12 +331,6 @@ 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." }
@@ -532,8 +527,8 @@ ARTICLE: "timestamp-arithmetic" "Timestamp arithmetic"
 { $subsections time+ }
 "Subtracting:"
 { $subsections time- }
-"Element-wise multiplication:"
-{ $subsections time* } ;
+"Multiplying durations:"
+{ $subsections duration* } ;
 
 ARTICLE: "using-durations" "Using durations"
 "Creating a duration object:"
index a95baf990ec0c2711e80b28b0d95457824132e08..f9fa3a08af6a53c262820947dd6d0075cc10d605 100644 (file)
@@ -15,7 +15,7 @@ ERROR: not-in-interval value interval ;
 
 HOOK: gmt-offset os ( -- hours minutes seconds )
 
-HOOK: now-gmt os ( -- timestamp )
+HOOK: now os ( -- timestamp )
 
 TUPLE: duration
     { year real }
@@ -448,9 +448,6 @@ 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 3fbe252511a474a8a728d8c596e298bfef3ca18f..cb850f8e43816ed89559014dde0cf18abb703c3b 100644 (file)
@@ -14,7 +14,7 @@ IN: calendar.unix
     timeval>seconds seconds ; inline
 
 : timeval>unix-time ( timeval -- timestamp )
-    [ unix-1970 ] dip timeval>seconds +second ; inline
+    unix-1970 swap 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 ] dip timespec>seconds +second ; inline
+    unix-1970 swap timespec>seconds +second ; inline
 
 : get-time ( -- alien )
     f time time_t <ref> localtime ; inline
@@ -40,5 +40,8 @@ M: unix gmt-offset
 : system-micros ( -- n )
     current-timeval timeval>micros ;
 
-M: unix now-gmt
-    current-timeval timeval>unix-time ;
+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* ;
index dea9f7257ea2b3cfd08260cf87ae52cf8fe39033..82e50786cadd0523551d43dc8b070ee063bffc31 100644 (file)
@@ -37,5 +37,6 @@ M: windows gmt-offset
         { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] }
     } case neg 60 /mod 0 ;
 
-M: windows now-gmt
-    SYSTEMTIME <struct> [ GetSystemTime ] keep SYSTEMTIME>timestamp ;
+M: windows now
+    SYSTEMTIME <struct> [ GetSystemTime ] keep SYSTEMTIME>timestamp
+    dup gmt-offset>> gmt-offset set-time drop ;
index a43f74ffab7cef11d17e673442b92e27e1d0778b..aaad309656abc3dbdf74a40607ec377b23388e80 100644 (file)
@@ -22,7 +22,7 @@ server-state f
 
 : expire-state ( class -- )
     new
-        -1/0. now-gmt timestamp>micros [a,b] >>expires
+        -1/0. now timestamp>micros [a,b] >>expires
     delete-tuples ;
 
 TUPLE: server-state-manager < filter-responder timeout ;
index 5690545268eb9dbbb081aa572d0d20f67b1aee90..744796bb44827207db824cbbe9033e0deb43cb26 100644 (file)
@@ -193,7 +193,7 @@ ERROR: invalid-header-string string ;
         "<" %
         64 random-bits #
         "-" %
-        now-gmt timestamp>micros #
+        now timestamp>micros #
         "@" %
         smtp-config get domain>> [ host-name ] unless* %
         ">" %
index 5c34a8c8c65b65120fa287c7b280323c05fa2a3d..b96434627b6f4ad3bbb959028ebd6576b8ed59ab 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-gmt timestamp>micros 10 * 0x01b21dd213814000 +
+    now timestamp>micros 10 * 0x01b21dd213814000 +
     [ -48 shift 0x0fff bitand ]
     [ -32 shift 0xffff bitand ]
     [ 0xffffffff bitand ]
index 67c2693e1ea1fe187e96ba7d80a19868412f25bf..96fc0f9c260c331e996dc16d41037c2ba87fcf0f 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-gmt os-envs current-directory get
+            now os-envs current-directory get
             real-user-id effective-user-id
             real-group-id effective-group-id
         ] dip [
index c4b48a2de33a7c7a3c33b3e8c9847b9dddceb6b1..75a1f0e7178679e14d587765ba2a1275a1fa7cf9 100644 (file)
@@ -12,7 +12,7 @@ CONSTANT: path "resource:key-log.txt"
 : update-key-caps-state ( -- )
     read-keyboard keys>>
     path binary [
-        [ now-gmt unix-1970 time- duration>nanoseconds >integer ]
+        [ now unix-1970 time- duration>nanoseconds >integer ]
         [ bit-array>integer ] bi*
         [ 8 >be write ] bi@ flush
     ] with-file-appender ;
index c425890c402bc05e8a921798157ea8763fd70793..e23a1934af8a21988e6943961f51c4008cecc617 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 74805f91e860b11ec0920eeea7f74fc9cec23eeb..5158c9afd04d479dd3c6ac2b97774c9650a56c6c 100644 (file)
@@ -8,7 +8,7 @@ IN: webapps.irc-log
 TUPLE: irclog-app < dispatcher ;
 
 : irc-link ( channel -- string )
-    now-gmt -7 hours convert-timezone >date<
+    now -7 hours convert-timezone >date<
     [ unparse 2 tail ] 2dip
     "http://bespin.org/~nef/logs/%s/%02s.%02d.%02d"
     sprintf ;