26 lines
851 B
Text
26 lines
851 B
Text
[ dup 400 mod 0 = iff [ drop true ] done
|
|
dup 100 mod 0 = iff [ drop false ] done
|
|
4 mod 0 = ] is leap ( y --> b )
|
|
|
|
[ dup 4 mod 5 *
|
|
over 100 mod 4 * +
|
|
swap 400 mod 6 * + 2 + 7 mod ] is doomsday ( y --> n )
|
|
|
|
[ leap iff [ ' [ table 0 4 1 ] ]
|
|
else [ ' [ table 0 3 7 ] ]
|
|
' [ 7 4 2 6 4 1 5 3 7 5 ] join do ] is close ( m y --> n )
|
|
|
|
[ dup doomsday unrot close - + 7 mod ] is weekday ( d m y --> n )
|
|
|
|
[ [ table $ "Sunday" $ "Monday"
|
|
$ "Tuesday" $ "Wednesday" $ "Thursday"
|
|
$ "Friday" $ "Saturday" ] do echo$ ] is echoday ( d --> )
|
|
|
|
' [ [ 6 1 1800 ]
|
|
[ 29 3 1875 ]
|
|
[ 7 12 1915 ]
|
|
[ 23 12 1970 ]
|
|
[ 14 5 2043 ]
|
|
[ 12 2 2077 ]
|
|
[ 2 4 2101 ] ]
|
|
witheach [ unpack weekday echoday cr ]
|