Previous: , Up: scheme library   [Index]


3.7.3 Examples

Examples for various ?import-specs and ?export-specs:

(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"

Examples for macros and phases:

(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 ...)])))

Previous: , Up: scheme library   [Index]