]> gitweb.factorcode.org Git - factor.git/commitdiff
calendar: Try out a potential locals syntax.
authorDoug Coleman <doug.coleman@gmail.com>
Wed, 12 Jan 2022 05:31:43 +0000 (23:31 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Wed, 12 Jan 2022 05:31:43 +0000 (23:31 -0600)
We are actually shadowing `f` in the `easter-month-day` word
before this patch.

basis/calendar/calendar-docs.factor
basis/calendar/calendar.factor

index e24abc61acdff7891b37d10aedb991ed41b264d0..226e72652f17517fa7e1c8895e7039aaa3a3bdc1 100644 (file)
@@ -51,12 +51,12 @@ HELP: seconds-per-year
 { $description "Returns the number of seconds in a year averaged over 400 years. Used internally for adding an arbitrary real number of seconds to a timestamp." } ;
 
 HELP: julian-day-number
-{ $values { "year" integer } { "month" integer } { "day" integer } { "n" integer } }
+{ $values { "$year" integer } { "$month" integer } { "$day" integer } { "n" integer } }
 { $description "Calculates the Julian day number from a year, month, and day. The difference between two Julian day numbers is the number of days that have elapsed between the two corresponding dates." }
 { $warning "Not valid before year -4800 BCE." } ;
 
 HELP: julian-day-number>date
-{ $values { "n" integer } { "year" integer } { "month" integer } { "day" integer } }
+{ $values { "$n" integer } { "year" integer } { "month" integer } { "day" integer } }
 { $description "Converts from a Julian day number back to a year, month, and day." } ;
 { julian-day-number julian-day-number>date } related-words
 
index 2356d1269929d2fc725fec13a3ec13cfd022b08d..b41af7955b5c5a2daaf1a5e1fe4351eedf25543c 100644 (file)
@@ -56,14 +56,14 @@ M: timestamp leap-year?
 : (days-in-month) ( year month -- n )
     dup 2 = [ drop leap-year? 29 28 ? ] [ nip day-counts nth ] if ;
 
-:: <timestamp> ( year month day hour minute second gmt-offset -- timestamp )
-    year
-    month 1 12 [a,b] check-interval
-    day 1 year month (days-in-month) [a,b] check-interval
-    hour 0 23 [a,b] check-interval
-    minute 0 59 [a,b] check-interval
-    second 0 60 [a,b) check-interval
-    gmt-offset timestamp boa ;
+:: <timestamp> ( $year $month $day $hour $minute $second $gmt-offset -- timestamp )
+    $year
+    $month 1 12 [a,b] check-interval
+    $day 1 $year $month (days-in-month) [a,b] check-interval
+    $hour 0 23 [a,b] check-interval
+    $minute 0 59 [a,b] check-interval
+    $second 0 60 [a,b) check-interval
+    $gmt-offset timestamp boa ;
 
 M: timestamp clone (clone) [ clone ] change-gmt-offset ;
 
@@ -89,44 +89,44 @@ CONSTANT: hours-per-year 876582/100
 CONSTANT: minutes-per-year 5259492/10
 CONSTANT: seconds-per-year 31556952
 
-:: julian-day-number ( year month day -- n )
+:: julian-day-number ( $year $month $day -- n )
     ! Returns a composite date number
     ! Not valid before year -4800
-    14 month - 12 /i :> a
-    year 4800 + a - :> y
-    month 12 a * + 3 - :> m
+    14 $month - 12 /i :> $a
+    $year 4800 + $a - :> $y
+    $month 12 $a * + 3 - :> $m
 
-    day 153 m * 2 + 5 /i + 365 y * +
-    y 4 /i + y 100 /i - y 400 /i + 32045 - ;
+    $day 153 $m * 2 + 5 /i + 365 $y * +
+    $y 4 /i + $y 100 /i - $y 400 /i + 32045 - ;
 
-:: julian-day-number>date ( n -- year month day )
+:: julian-day-number>date ( $n -- year month day )
     ! Inverse of julian-day-number
-    n 32044 + :> a
-    4 a * 3 + 146097 /i :> b
-    a 146097 b * 4 /i - :> c
-    4 c * 3 + 1461 /i :> d
-    c 1461 d * 4 /i - :> e
-    5 e * 2 + 153 /i :> m
-
-    100 b * d + 4800 -
-    m 10 /i + m 3 +
-    12 m 10 /i * -
-    e 153 m * 2 + 5 /i - 1 + ;
+    $n 32044 + :> $a
+    4 $a * 3 + 146097 /i :> $b
+    $a 146097 $b * 4 /i - :> $c
+    4 $c * 3 + 1461 /i :> $d
+    $c 1461 $d * 4 /i - :> $e
+    5 $e * 2 + 153 /i :> $m
+
+    100 $b * $d + 4800 -
+    $m 10 /i + $m 3 +
+    12 $m 10 /i * -
+    $e 153 $m * 2 + 5 /i - 1 + ;
 
 GENERIC: easter ( obj -- obj' )
 
-:: easter-month-day ( year -- month day )
-    year 19 mod :> a
-    year 100 /mod :> ( b c )
-    b 4 /mod :> ( d e )
-    b 8 + 25 /i :> f
-    b f - 1 + 3 /i :> g
-    19 a * b + d - g - 15 + 30 mod :> h
-    c 4 /mod :> ( i k )
-    32 2 e * + 2 i * + h - k - 7 mod :> l
-    a 11 h * + 22 l * + 451 /i :> m
+:: easter-month-day ( $year -- month day )
+    $year 19 mod :> $a
+    $year 100 /mod :> ( $b $c )
+    $b 4 /mod :> ( $d $e )
+    $b 8 + 25 /i :> $f
+    $b $f - 1 + 3 /i :> $g
+    19 $a * $b + $d - $g - 15 + 30 mod :> $h
+    $c 4 /mod :> ( $i $k )
+    32 2 $e * + 2 $i * + $h - $k - 7 mod :> $l
+    $a 11 $h * + 22 $l * + 451 /i :> $m
 
-    h l + 7 m * - 114 + 31 /mod 1 + ;
+    $h $l + 7 $m * - 114 + 31 /mod 1 + ;
 
 M: integer easter
     dup easter-month-day <date> ;
@@ -344,10 +344,10 @@ M: timestamp <=> [ >gmt tuple-slots ] compare ;
 : same-month? ( ts1 ts2 -- ? )
     [ slots{ year month } ] same? ;
 
-:: (day-of-year) ( year month day -- n )
-    month cumulative-day-counts nth day + {
-        [ year leap-year? ]
-        [ month 3 >= ]
+:: (day-of-year) ( $year $month $day -- n )
+    $month cumulative-day-counts nth $day + {
+        [ $year leap-year? ]
+        [ $month 3 >= ]
     } 0&& [ 1 + ] when ;
 
 : day-of-year ( timestamp -- n )
@@ -580,11 +580,11 @@ M: integer last-day-of-year 12 31 <date> ;
     [ dup day-of-week 7 swap - ] [ + 7 mod ] bi*
     { 0 1 2 3 -3 -2 -1 } nth days time+ ;
 
-:: nth-day-this-month ( timestamp n day -- timestamp' )
-    timestamp clone
-    timestamp start-of-month day day-this-week
+:: nth-day-this-month ( $timestamp $n $day -- timestamp' )
+    $timestamp clone
+    $timestamp start-of-month $day day-this-week
     [ [ month>> ] same? ] keep swap
-    [ n ] [ n 1 + ] if weeks time+ ;
+    [ $n ] [ $n 1 + ] if weeks time+ ;
 
 PRIVATE>