R6RS:翻訳:R6RS:7.3 Examples

7.3. 例

<import spec>、<export spec> の様々な例。

 (library (stack)
  (export make push! pop! empty!)
 
  (import (rnrs) (rnrs mutable-pairs))
  (define (make) (list ’()))
  (define (push! s v) (set-car! s (cons v (car s))))
  (define (pop! s) (let ([v (caar s)])
                     (set-car! s (cdar s))
                     v))
  (define (empty! s) (set-car! s ’())))
 
 (library (balloons)
  (export make push pop)
  (import (rnrs))
  (define (make w h) (cons w h))
  (define (push b amt)
    (cons (- (car b) amt) (+ (cdr b) amt)))
  (define (pop b) (display "Boom! ")
    (display (* (car b) (cdr b)))
    (newline)))
 (library (party)
 ;; Total exports:
 ;; make, push, push!, make-party, pop!
  (export (rename (balloon:make make)
                  (balloon:push push))
          push!
          make-party
          (rename (party-pop! pop!)))
  (import (rnrs)
          (only (stack) make push! pop!) ; not empty!
          (prefix (balloons) balloon:))
  ;; Creates a party as a stack of balloons,
  ;; starting with two balloons
  (define (make-party)
    (let ([s (make)]) ; from stack
      (push! s (balloon:make 10 10))
      (push! s (balloon:make 12 9))
      s))
  (define (party-pop! p)
    (balloon:pop (pop! p))))
 (library (main)
  (export)
  (import (rnrs) (party))
  (define p (make-party))
  (pop! p) ; displays "Boom! 108"
  (push! p (push (make 5 5) 1))
  (pop! p)) ; displays "Boom! 24"

マクロとフェーズの例:

 (library (my-helpers id-stuff)
  (export find-dup)
  (import (rnrs))
  (define (find-dup l)
    (and (pair? l)
         (let loop ((rest (cdr l)))
           (cond
            [(null? rest) (find-dup (cdr l))]
            [(bound-identifier=? (car l) (car rest))
             (car rest)]
            [else (loop (cdr rest))])))))
 (library (my-helpers values-stuff)
  (export mvlet)
  (import (rnrs) (for (my-helpers id-stuff) expand))
  (define-syntax mvlet
    (lambda (stx)
      (syntax-case stx ()
        [( [(id ...) expr] body0 body ...)
         (not (find-dup (syntax (id ...))))
         (syntax
          (call-with-values
              (lambda () expr)
            (lambda (id ...) body0 body ...)))]))))
 (library (let-div)
  (export let-div)
  (import (rnrs)
          (my-helpers values-stuff)
          (rnrs r5rs))
  (define (quotient+remainder n d)
    (let ([q (quotient n d)])
      (values q (- n (* q d)))))
  (define-syntax let-div
    (syntax-rules ()
      [( n d (q r) body0 body ...)
       (mvlet [(q r) (quotient+remainder n d)]
              body0 body ...)])))