Artifact a4e401b81b577700a492f986426d562006c8e5b6:

• File srfi/private/vanish.sls — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 1260)

#!r6rs
;; Copyright (c) 2009 Derick Eddington.  All rights reserved.
;; Licensed under an MIT-style license.  My license is in the file
;; named LICENSE from the original collection this file is distributed
;; with.  If this file is redistributed with some other collection, my
;; license must also be included.

(library (srfi private vanish)
  (export
    vanish-define)
  (import
    (rnrs)
    (for (only (rnrs base) begin) (meta -1)))

  #;(define (show stx)
    (display (make-string 60 #\-)) (newline)
    (write (syntax->datum stx)) (newline))

  (define-syntax vanish-define
    (lambda (stx)
      (syntax-case stx ()
        ((_ def (vanish ...))
         (for-all identifier? #'(vanish ...))
         #'(make-vanish-define (syntax def) (syntax vanish) ...)))))

  (define (make-vanish-define def . to-vanish)
    (lambda (stx)
      (define (vanish? id)
        (memp (lambda (x) (free-identifier=? id x))
              to-vanish))
      #;(show stx)
      (syntax-case stx ()
        ((_ name . _)
         (and (identifier? #'name)
              (vanish? #'name))
         #'(begin))
        ((_ (name . _) . _)
         (and (identifier? #'name)
              (vanish? #'name))
         #'(begin))
        ((_ . r)
         (cons def #'r)))))
)