source: project/release/3/srfi-19/trunk/srfi-19-common.scm @ 12029

Last change on this file since 12029 was 12029, checked in by Kon Lovett, 13 years ago

Save.

File size: 2.4 KB
Line 
1;;;; srfi-19-common.scm
2
3;; -- Miscellaneous Constants.
4
5(define-constant NS/MS  1000000)
6(define-constant NS/MuS 1000)
7
8(define-constant MS/S  1000)
9(define-constant MuS/S 1000000)
10(define-constant NS/S  1000000000)
11
12(define-constant SEC/DY   86400)    ; seconds in a day
13(define-constant SEC/DY/2 43200)    ; seconds in a half day
14(define-constant SEC/HR   3600)
15(define-constant SEC/MIN  60)
16
17#|
18(define-constant iNS/S    1000000000.0)
19(define-constant iSEC/DY  86400.0)
20(define-constant iONE-HALF  0.5)
21|#
22
23(define-constant HR/DY 24)
24
25(define-constant DY/WK 7)
26(define-constant DY/MN 31)  ;maximum days per month
27(define-constant DY/YR 365) ;normal days per year
28
29(define-constant MN/YR 12)
30
31; Daylight saving time offset from standard offset.
32; ("spring forward" add it, "fall back" subtract it)
33(define-constant DEFAULT-DST-OFFSET 3600)
34
35;;
36
37(define-inline (->boolean obj)
38  (and obj
39       #t) )
40
41(define-inline (fxabs x)
42  (if (fx< x 0) (fxneg x) x) )
43
44#;
45(define-inline (inexact-integer? x)
46  (and (inexact? x) (integer? x)) )
47
48;; For storage savings since some aritmetic routines do not
49;; return fixnums when possible.
50
51;; ##sys#number?
52;; returns #t for fixnum or flonum
53
54;; ##sys#double->number
55;; returns a fixnum for the flonum iff x isa integer in fixnum-range
56;; otherwise the flonum
57
58; When domain is integer and range is fixnum
59; Number MUST be a fixnum or flonum
60
61(define-inline (->fixnum x)
62  (if (fixnum? x) x (##sys#double->number x))
63  #;
64  (inexact->exact x) )
65
66; When domain is integer and range is flonum-integer
67; Conversion attemped only when number is a fixnum or flonum-integer
68; Others returned
69
70(define-inline (->fixnum* x)
71  (if (##sys#integer? x) (->fixnum x) x)
72  #;
73  (if (inexact-integer? x) (->fixnum x) x) )
74
75;;
76
77(define-inline (tm:days-before-first-week date day-of-week-starting-week)
78  (fxmod
79    (fx- day-of-week-starting-week (tm:week-day 1 1 (date-year date)))
80    DY/WK) )
81
82;; There are 3 kinds of time record procedures:
83;; %...   - generated (these are inline!)
84;; tm:... - argument processing then %...
85;; ...    - argument checking then tm:...
86
87(define-record-type/unsafe-inline-unchecked time
88  (%make-time timtyp ns sec)
89  %time?
90  (timtyp %time-type        %set-time-type!)
91  (ns     %time-nanosecond  %set-time-nanosecond!)
92  (sec    %time-second      %set-time-second!) )
93
94(define-inline (%check-time loc obj)
95  (##sys#check-structure obj 'time loc) )
Note: See TracBrowser for help on using the repository browser.