blob: 36edc1619c8751fe8d18e4e69b53221219a1e714 (
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
117
118
119
120
121
122
123
124
125
126
|
(export
and
boolean=?
boolean?
case-lambda
cond
if
not
or
unless
when)
(import (only (csc builtins)
builtin-if
call-builtin))
(begin
(define-syntax if
(syntax-rules ()
((if test consequent)
(builtin-if test consequent #f))
((if test consequent alternate)
(builtin-if test consequent alternate))))
(define-syntax cond
(syntax-rules (else =>)
((cond (else result1 result2 ...))
(begin result1 result2 ...))
((cond (test => result))
(let ((temp test))
(if temp (result temp))))
((cond (test => result) clause1 clause2 ...)
(let ((temp test))
(if temp
(result temp)
(cond clause1 clause2 ...))))
((cond (test)) test)
((cond (test) clause1 clause2 ...)
(let ((temp test))
(if temp
temp
(cond clause1 clause2 ...))))
((cond (test result1 result2 ...))
(if test (begin result1 result2 ...)))
((cond (test result1 result2 ...)
clause1 clause2 ...)
(if test
(begin result1 result2 ...)
(cond clause1 clause2 ...)))))
(define-syntax and
(syntax-rules ()
((and) #t)
((and test) test)
((and test1 test2 ...)
(if test1 (and test2 ...) #f))))
(define-syntax or
(syntax-rules ()
((or) #f)
((or test) test)
((or test1 test2 ...)
(let ((x test1))
(if x x (or test2 ...))))))
(define-syntax when
(syntax-rules ()
((when test result1 result2 ...)
(if test
(begin result1 result2 ...)))))
(define-syntax unless
(syntax-rules ()
((unless test result1 result2 ...)
(if (not test)
(begin result1 result2 ...)))))
(define-syntax case-lambda
(syntax-rules ()
((case-lambda (params body0 ...) ...)
(lambda args
(let ((len (length args)))
(let-syntax
((cl (syntax-rules ::: ()
((cl)
(error "no matching clause"))
((cl ((p :::) . body) . rest)
(if (= len (length ’(p :::)))
(apply (lambda (p :::)
. body)
args)
(cl . rest)))
((cl ((p ::: . tail) . body)
. rest)
(if (>= len (length ’(p :::)))
(apply
(lambda (p ::: . tail)
. body)
args)
(cl . rest))))))
(cl (params body0 ...) ...)))))))
(define (not obj)
(if obj
#f
#t))
(define (boolean? obj)
(call-builtin eq? 2 (call-builtin typeof obj)))
(define (boolean=? b1 b2 . bs)
(and (boolean? b1)
(let loop ((bs (cons b2 bs)))
(or (null? bs)
(and (boolean? (car bs))
(call-builtin eq? b1 (car bs))
(loop (cdr bs))))))))
|
