suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Converting to racket and with contracts

Browse Source 
original commit: 581458f0be2d6adf04933b00515643c6e383087a
This commit is contained in:
Jay McCarthy 2010-05-24 13:25:14 -06:00
parent 7e00a44f62
commit e2aeb764f6
1 changed files with 340 additions and 376 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
collects/mzlib/date.rkt
View File

@ -1,59 +1,26 @@
#lang racket/base
(require racket/promise
racket/contract)
(module date mzscheme
(require "list.rkt")
(provide date->string
date-display-format
find-seconds
date->julian/scalinger
julian/scalinger->string)
(provide/contract
[date->string ((date?) (boolean?) . ->* . string?)]
[date-display-format (parameter/c (symbols 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc2822))]
[find-seconds ((integer-in 0 61)
(integer-in 0 59)
(integer-in 0 23)
(integer-in 1 31)
(integer-in 1 12)
exact-nonnegative-integer?
. -> .
exact-integer?)]
[date->julian/scalinger (date? . -> . exact-integer?)]
[julian/scalinger->string (exact-integer? . -> . string?)])
;; Support for Julian calendar added by Shriram;
;; 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
(make-parameter 'american
(lambda (s)
(unless (memq s legal-formats)
(raise-type-error 'date-display-format
(format "symbol in ~a" legal-formats)
s))
s)))
(make-parameter 'american))
(define month/number->string
(lambda (x)
@ -386,6 +353,3 @@
(cadr reversed-digits)
(car reversed-digits)))
(loop (cdr (cdr (cdr reversed-digits))))))))))))
)