aboutsummaryrefslogtreecommitdiffstats
path: root/lib/scheme/base/30-if.csc
blob: 09012faa784baec8f2434c51e3e43a17c3afc3f5 (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
(export
  and
  cond
  if
  or
  unless
  when)
(import (only (csc builtins)
          builtin-if))
(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 ...))))))