blob: 574bb0480880eb9a8fb8390272b7b4d7df01fff9 (
about) (
plain)
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
|
;;; ps-utils --- Utilities for Pre-Scheme
(define-syntax when
(syntax-rules ()
((_ condition consequent ...)
(if condition
(begin consequent ...)))))
(define-syntax unless
(syntax-rules ()
((_ condition antecedent ...)
(if (not condition)
(begin antecedent ...)))))
(define-syntax define-wrapper-type
(lambda (exp rename compare)
(define (symbol-append . args)
(string->symbol
(apply string-append (map (lambda (s)
(if (string? s) s (symbol->string s)))
args))))
(let* ((name (cadr exp))
(type-id (symbol-append ":" name))
(constructor (rename (symbol-append "make-" name)))
(%begin (rename 'begin))
(%define-record-type (rename 'define-record-type))
(%define-external (rename 'define-external)))
`(,%define-record-type ,name ,type-id
(,constructor)))))
(define (zero? n) (= n 0))
(define (one? n) (= n 1))
|
