| Paste number 75331: | r6rs, if-is-defined macro |
| Pasted by: | Slom |
| When: | 3 years, 3 months ago |
| Share: | Tweet this! | http://paste.lisp.org/+1M4J |
| Channel: | None |
| Paste contents: |
(library (slom utils if-is-defined)
(export if-is-defined/expr
if-is-defined/stmt
if-is-not-defined/expr
if-is-not-defined/stmt
is-defined?)
(import (only (rnrs)
define-syntax
lambda
syntax-case
if
or
free-identifier=?
syntax
not
datum->syntax
syntax->datum))
(define-syntax if-is-defined
(lambda (x)
(syntax-case x ()
((_ ?var ?sk ?fk)
(if (or (free-identifier=? #'?var #'define-syntax)
(free-identifier=? #'?var #'lambda)
(free-identifier=? #'?var #'syntax-case)
(free-identifier=? #'?var #'syntax)
(free-identifier=? #'?var #'if)
(free-identifier=? #'?var #'or)
(free-identifier=? #'?var #'not)
(free-identifier=? #'?var #'free-identifier=?)
(free-identifier=? #'?var #'datum->syntax)
(free-identifier=? #'?var #'syntax->datum)
(free-identifier=? #'?var #'begin)
(not (free-identifier=? (datum->syntax #'if-is-defined
(syntax->datum #'?var))
#'?var)))
#'?sk
#'?fk)))))
(define-syntax if-is-defined/stmt
(lambda (x)
(syntax-case x ()
((_ ?var ?sk ?fk)
#'(if-is-defined ?var ?sk ?fk))
((_ ?var ?sk)
#'(if-is-defined ?var ?sk (begin))))))
(define-syntax if-is-defined/expr
(lambda (x)
(syntax-case x ()
((_ ?var ?sk ?fk)
#'(if-is-defined ?var ?sk ?fk))
((_ ?var ?sk)
#'(if-is-defined ?var ?sk (if #f #f))))))
(define-syntax if-is-not-defined/stmt
(lambda (x)
(syntax-case x ()
((_ ?var ?sk ?fk)
#'(if-is-defined ?var ?fk ?sk))
((_ ?var ?sk)
#'(if-is-defined ?var (begin) ?sk)))))
(define-syntax if-is-not-defined/expr
(lambda (x)
(syntax-case x ()
((_ ?var ?sk ?fk)
#'(if-is-defined ?var ?fk ?sk))
((_ ?var ?sk)
#'(if-is-defined ?var (if #f #f) ?sk)))))
(define-syntax is-defined?
(lambda (x)
(syntax-case x ()
((_ ?var)
#'(if-is-defined/expr ?var #t #f)))))
) ;; library
(library (slom test)
(export foo)
(import (rnrs)
(slom utils if-is-defined))
(define-record-type box
(fields content))
(define-syntax add-to-box
(syntax-rules ()
((_ ?box ?val)
(begin (if-is-not-defined/stmt ?box
(define ?box (make-box '())))
(box-content-set! ?box (cons ?val (box-content ?box)))))))
(define foo (make-box '()))
(add-to-box foo 1)
(add-to-box foo 2)
) ;; libraryAnnotations for this paste:
| Annotation number 1: | failing version ... |
| Pasted by: | Slom |
| When: | 3 years, 3 months ago |
| Share: | Tweet this! | http://paste.lisp.org/+1M4J/1 |
| Paste contents: |
(library (slom utils if-is-defined)
(export if-is-defined/expr
if-is-defined/stmt
if-is-not-defined/expr
if-is-not-defined/stmt
is-defined?)
(import (only (rnrs)
define-syntax
lambda
syntax-case
if
or
free-identifier=?
syntax
not
datum->syntax
syntax->datum))
(define-syntax if-is-defined
(lambda (x)
(syntax-case x ()
((_ ?var ?sk ?fk)
(if (or (free-identifier=? #'?var #'define-syntax)
(free-identifier=? #'?var #'lambda)
(free-identifier=? #'?var #'syntax-case)
(free-identifier=? #'?var #'syntax)
(free-identifier=? #'?var #'if)
(free-identifier=? #'?var #'or)
(free-identifier=? #'?var #'not)
(free-identifier=? #'?var #'free-identifier=?)
(free-identifier=? #'?var #'datum->syntax)
(free-identifier=? #'?var #'syntax->datum)
(free-identifier=? #'?var #'begin)
(not (free-identifier=? (datum->syntax #'if-is-defined
(syntax->datum #'?var))
#'?var)))
#'?sk
#'?fk)))))
(define-syntax if-is-defined/stmt
(lambda (x)
(syntax-case x ()
((_ ?var ?sk ?fk)
#'(if-is-defined ?var ?sk ?fk))
((_ ?var ?sk)
#'(if-is-defined ?var ?sk (begin))))))
(define-syntax if-is-defined/expr
(lambda (x)
(syntax-case x ()
((_ ?var ?sk ?fk)
#'(if-is-defined ?var ?sk ?fk))
((_ ?var ?sk)
#'(if-is-defined ?var ?sk (if #f #f))))))
(define-syntax if-is-not-defined/stmt
(lambda (x)
(syntax-case x ()
((_ ?var ?sk ?fk)
#'(if-is-defined ?var ?fk ?sk))
((_ ?var ?sk)
#'(if-is-defined ?var (begin) ?sk)))))
(define-syntax if-is-not-defined/expr
(lambda (x)
(syntax-case x ()
((_ ?var ?sk ?fk)
#'(if-is-defined ?var ?fk ?sk))
((_ ?var ?sk)
#'(if-is-defined ?var (if #f #f) ?sk)))))
(define-syntax is-defined?
(lambda (x)
(syntax-case x ()
((_ ?var)
#'(if-is-defined/expr ?var #t #f)))))
) ;; library
(library (slom test)
(export foo)
(import (rnrs)
(slom utils if-is-defined))
(define-record-type box
(fields content))
(define-syntax add-to-box
(syntax-rules ()
((_ ?box ?val)
(begin (if-is-not-defined/stmt ?box
(define ?box (make-box '())))
(box-content-set! ?box (cons ?val (box-content ?box)))))))
(add-to-box foo 1)
(add-to-box foo 2)
) ;; library