Converting to racket and with contracts

original commit: 581458f0be2d6adf04933b00515643c6e383087a
This commit is contained in:
Jay McCarthy 2010-05-24 13:25:14 -06:00
parent 7e00a44f62
commit e2aeb764f6

View File

@ -1,59 +1,26 @@
#lang racket/base
(require racket/promise
racket/contract)
(module date mzscheme (provide/contract
[date->string ((date?) (boolean?) . ->* . string?)]
(require "list.rkt") [date-display-format (parameter/c (symbols 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc2822))]
[find-seconds ((integer-in 0 61)
(provide date->string (integer-in 0 59)
date-display-format (integer-in 0 23)
find-seconds (integer-in 1 31)
(integer-in 1 12)
date->julian/scalinger exact-nonnegative-integer?
julian/scalinger->string) . -> .
exact-integer?)]
[date->julian/scalinger (date? . -> . exact-integer?)]
[julian/scalinger->string (exact-integer? . -> . string?)])
;; Support for Julian calendar added by Shriram; ;; Support for Julian calendar added by Shriram;
;; current version only works until 2099 CE Gregorian ;; current version only works until 2099 CE Gregorian
#|
(define-primitive seconds->date (num -> structure:date))
(define-primitive current-seconds (-> num))
(define-primitive date-second (structure:date -> num))
(define-primitive date-minute (structure:date -> num))
(define-primitive date-hour (structure:date -> num))
(define-primitive date-day (structure:date -> num))
(define-primitive date-month (structure:date -> num))
(define-primitive date-year (structure:date -> num))
(define-primitive date-week-day (structure:date -> num))
(define-primitive date-year-day (structure:date -> num))
(define-primitive date-dst? (structure:date -> bool))
(define-primitive make-date (num num num num num num num num bool ->
structure:date))
(define-primitive expr->string (a -> string))
(define-primitive foldl (case->
((a z -> z) z (listof a) -> z)
((a b z -> z) z (listof a) (listof b) -> z)
((a b c z -> z) z (listof a) (listof b) (listof c) -> z)
(((arglistof x) ->* z) z (listof (arglistof x)) ->* z)))
(define-primitive foldr (case->
((a z -> z) z (listof a) -> z)
((a b z -> z) z (listof a) (listof b) -> z)
((a b c z -> z) z (listof a) (listof b) (listof c) -> z)
(((arglistof x) ->* z) z (listof (arglistof x)) ->* z)))
|#
(define legal-formats
(list 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc2822))
(define date-display-format (define date-display-format
(make-parameter 'american (make-parameter 'american))
(lambda (s)
(unless (memq s legal-formats)
(raise-type-error 'date-display-format
(format "symbol in ~a" legal-formats)
s))
s)))
(define month/number->string (define month/number->string
(lambda (x) (lambda (x)
@ -386,6 +353,3 @@
(cadr reversed-digits) (cadr reversed-digits)
(car reversed-digits))) (car reversed-digits)))
(loop (cdr (cdr (cdr reversed-digits)))))))))))) (loop (cdr (cdr (cdr reversed-digits))))))))))))
)