Paste number 75331: r6rs, if-is-defined macro

Index of paste annotations: 1

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:
Raw Source | XML | Display As

(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)
  
  ) ;; library

Annotations 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:
Raw Source | Display As
(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

Colorize as:
Show Line Numbers
Index of paste annotations: 1

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.