1 let is_leap year = (year mod 4 = 0 && year mod 100 <> 0) || year mod 400 = 0 2 3 let days_in_month ~year ~month = 4 match month with 5 | 1 | 3 | 5 | 7 | 8 | 10 | 12 -> 31 6 | 4 | 6 | 9 | 11 -> 30 7 | 2 -> if is_leap year then 29 else 28 8 | _ -> invalid_arg "Calendar.days_in_month: month" 9 10 let validate_date ~year ~month ~day = 11 if month < 1 || month > 12 then invalid_arg "Calendar.date: month"; 12 if day < 1 || day > days_in_month ~year ~month then 13 invalid_arg "Calendar.date: day" 14 15 let days_since_epoch ~year ~month ~day = 16 validate_date ~year ~month ~day; 17 let year = if month <= 2 then year - 1 else year in 18 let era = (if year >= 0 then year else year - 399) / 400 in 19 let year_of_era = year - (era * 400) in 20 let day_of_year = 21 (((153 * if month > 2 then month - 3 else month + 9) + 2) / 5) + day - 1 22 in 23 let day_of_era = 24 (year_of_era * 365) + (year_of_era / 4) - (year_of_era / 100) + day_of_year 25 in 26 (era * 146097) + day_of_era - 719468 27 28 (* The weekday of a given UTC date, 0 = Monday .. 6 = Sunday. This uses Howard 29 Hinnant's day-count from the epoch. The count needs no timezone-aware libc 30 call, because [timegm] is not in the stdlib. *) 31 let monday_first_weekday ~year ~month ~day = 32 let days = days_since_epoch ~year ~month ~day in 33 (* 1970-01-01 is a Thursday = 3 in Monday-first indexing. *) 34 ((((days mod 7) + 3) mod 7) + 7) mod 7 35 36 let unix_seconds_of_date ~year ~month ~day = 37 days_since_epoch ~year ~month ~day * 86_400 38