1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Mike Sperber
(define (adjoin-bits high low k)
(+ (shift-left high k) low))
(define (low-bits n k)
(bitwise-and n (- (shift-left 1 k) 1)))
(define high-bits arithmetic-shift-right)
(define unsigned-high-bits logical-shift-right)
(define (digit? ch)
(let ((ch (char->ascii ch)))
(and (>= ch (char->ascii #\0))
(<= ch (char->ascii #\9)))))
(define (vector+length-fill! v length x)
(do ((i 0 (+ i 1)))
((>= i length))
(vector-set! v i x)))
; Apply PROC to 0 ... N-1.
(define (natural-for-each proc n)
(do ((i 0 (+ i 1)))
((= i n))
(proc i)))
(define (natural-for-each-while proc n)
(do ((i 0 (+ i 1)))
((or (= i n)
(not (proc i))))))
;----------------
; stderr
(define (error? status)
(not (eq? status (enum errors no-errors))))
(define (write-error-string string)
(write-string string (current-error-port)))
(define (write-error-integer integer)
(write-integer integer (current-error-port)))
(define (write-error-newline)
(write-char #\newline (current-error-port)))
(define (error-message string)
(write-error-string string)
(write-error-newline))
; stdout
(define (write-out-string string)
(write-string string (current-output-port)))
(define (write-out-integer integer)
(write-integer integer (current-output-port)))
(define (write-out-newline)
(write-char #\newline (current-output-port)))
(define (display-message str)
(write-out-string str)
(write-out-newline))
(define (display-integer int)
(write-out-integer int)
(write-out-newline))
|
