blob: c3f56121a6490a19cd2273bc9ea0e567262c1526 (
plain) (
blame)
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
; This is a init file for Mini-Scheme.
; Modified for UNSLISP.
(define modulo remainder)
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))
(define (caaar x) (car (car (car x))))
(define (caadr x) (car (car (cdr x))))
(define (cadar x) (car (cdr (car x))))
(define (caddr x) (car (cdr (cdr x))))
(define (cdaar x) (cdr (car (car x))))
(define (cdadr x) (cdr (car (cdr x))))
(define (cddar x) (cdr (cdr (car x))))
(define (cdddr x) (cdr (cdr (cdr x))))
(define (list . x) x)
(define (map proc list)
(if (pair? list)
(cons (proc (car list)) (map proc (cdr list)))))
(define (for-each proc list)
(if (pair? list)
(begin (proc (car list)) (for-each proc (cdr list)))
#t ))
(define (list-tail x k)
(if (zero? k)
x
(list-tail (cdr x) (- k 1))))
(define (list-ref x k)
(car (list-tail x k)))
(define list-set!
(lambda (lst k obj)
(if (= k 0)
(set-car! lst obj)
(list-set! (cdr lst) (- k 1) obj))))
(define (last-pair x)
(if (pair? (cdr x))
(last-pair (cdr x))
x))
(define vector list)
(define vector-ref list-ref)
(define vector-set! list-set!)
(define make-vector
(lambda (num)
(letrec
((loop
(lambda (iter cell)
(if (= iter 0)
cell
(loop (- iter 1) (cons #f cell))))))
(loop num '()))))
(define (head stream) (car stream))
(define (tail stream) (force (cdr stream)))
(define (eof-object? x) (eq? x #f))
;;;;; following part is written by a.k
;;;; atom?
(define (atom? x)
(not (pair? x)))
;;;; memq
(define (memq obj lst)
(cond
((null? lst) #f)
((eq? obj (car lst)) lst)
(else (memq obj (cdr lst)))))
;;;; equal?
(define (equal? x y)
(if (pair? x)
(and (pair? y)
(equal? (car x) (car y))
(equal? (cdr x) (cdr y)))
(and (not (pair? y))
(eqv? x y))))
;;; Emulation of mutable strings.
(define string-ref list-ref)
(define string-set! list-set!)
(define string list)
(define list<=>
(lambda (x y <=>)
(cond
((and (null? x) (null? y)) '=)
((null? x) '<)
((null? y) '>)
(else
(let ((dir (<=> (car x) (car y))))
(if (eq? dir '=)
(list<=> (cdr x) (cdr y) <=>)
dir))))))
(define string<=>
(lambda (x y)
(list<=> x y (lambda (x y)
(if (eqv? x y)
'=
(if (< (char->integer x) (char->integer y))
'<
'>))))))
|
