1. ; time arithmetic
2.
3. (define (julian year month day)
4. (let* ((a (quotient (- 14 month) 12))
5. (y (+ year 4800 (- a)))
6. (m (+ month (* 12 a) -3)))
7. (+ day
8. (quotient (+ (* 153 m) 2) 5)
9. (* 365 y)
10. (quotient y 4)
11. (- (quotient y 100))
12. (quotient y 400)
13. (- 32045))))
14.
15. (define (gregorian julian)
16. (let* ((j (+ julian 32044))
17. (g (quotient j 146097))
18. (dg (modulo j 146097))
19. (c (quotient (* (+ (quotient dg 36524) 1) 3) 4))
20. (dc (- dg (* c 36524)))
21. (b (quotient dc 1461))
22. (db (modulo dc 1461))
23. (a (quotient (* (+ (quotient db 365) 1) 3) 4))
24. (da (- db (* a 365)))
25. (y (+ (* g 400) (* c 100) (* b 4) a))
26. (m (- (quotient (+ (* da 5) 308) 153) 2))
27. (d (+ da (- (quotient (* (+ m 4) 153) 5)) 122))
28. (year (+ y (- 4800) (quotient (+ m 2) 12)))
29. (month (+ (modulo (+ m 2) 12) 1))
30. (day (+ d 1)))
31. (values year month day)))
32.
33. (define (julian-time year month day hour minute second)
34. (+ (julian year month day)
35. (/ (+ (* hour 60 60) (* minute 60) second) 86400)))
36.
37. (define (gregorian-time time-stamp)
38. (let* ((date (floor time-stamp))
39. (time (* (- time-stamp date) 86400))
40. (hour (quotient time 3600))
41. (minute (modulo (quotient time 60) 60))
42. (second (modulo time 60)))
43. (call-with-values
44. (lambda () (gregorian date))
45. (lambda (year month day)
46. (values year month day hour minute second)))))
47.
48. (display (julian-time 2015 9 14 10 39 42)) (newline)
49.
50. (call-with-values
51. (lambda () (gregorian-time (julian-time 2015 9 14 10 39 42)))
52. (lambda (year month day hour minute second)
53. (display year) (newline)
54. (display month) (newline)
55. (display day) (newline)
56. (display hour) (newline)
57. (display minute) (newline)
58. (display second) (newline)))
Success #stdin #stdout 0.05s 8744KB
stdin
Standard input is empty
stdout
35384838397/14400
2015
9
14
10
39
42