[plt-scheme] define-union

Or you can use (define-union snark (foo bar number) like this:

(define-macro define-union
  (lambda (name types)
    (if (not (list? tu
    (define (add-? s)
      (if (not (symbol? s))
          (error 'define-union "~a is not a data type" s))
      (string->symbol (string-append (symbol->string s) "?")))
    (let ([discriminators (map add-? types)]
          [final-descriminator (add-? name)])
      (define (with-handlers-discriminators)
        (define (iter discs)
          (if (empty? discs)
              empty
              (cons `(with-handlers ([exn? (lambda args (error 
'define-union "~a is not a data type discriminator"
                                                               ,(car 
discs)))])
                       ,(car discs))
                    (iter (cdr discs)))))
        (cons `list (iter discriminators)))
      `(define ,final-descriminator
         (let ([discs ,(with-handlers-discriminators)])
           (define (check-discriminator f)
             (if (not (and (procedure? f)
                           (procedure-arity-includes? f 1))) ; checks 
that can be called with one argument
                 (error 'define-union "~a is not a data type 
discriminator" f)))
           (for-each check-discriminator discs)
           (lambda (data)
             (ormap (lambda (disc) (disc data)) discs)))))))


Hope there aren't any missing parens.


Jacob Matthews wrote:

>  For list-related administrative tasks:
>  http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
>On Fri, 18 Apr 2003, Anton van Straaten wrote:
>
>  
>
>>How about modifying your spec slightly to allow this:
>>
>>	(define-union snark? (foo? bar? number?))
>>
>>...which would allow you to use this:
>>
>>	(define-syntax define-union
>>	  (syntax-rules ()
>>	    ((_ name (pred ...))
>>	     (define (name x) (or (pred x) ...)))))
>>
>>...which has the virtue of being very simple to implement and understand.
>>
>>    
>>
>
>If you modify the spec just a little more, you don't need a macro at all.
>You just need to be willing to use regular define rather than introducing
>the new keyword define-union.
>
>(define (union . predicates)
>  (lambda (item) (ormap (lambda (f) (f item)) predicates)))
>
>(define snark? (union foo? bar? number?))
>
>  
>
>>(snark? (make-foo 'a 'b))
>>    
>>
>#t
>  
>
>>(snark? (make-bar 'c 'b #f))
>>    
>>
>#t
>  
>
>>(snark? 453)
>>    
>>
>#t
>  
>
>>(snark? 'snark)
>>    
>>
>#f
>  
>
>>(snark? "I'm a snark! Honest!")
>>    
>>
>#f
>
>If you want the error-detection Robby added in, you can use this ugly guy:
>
>(define (union . predicates)
>  (let* ([nonpredicate?
>          (lambda (p)
>            (if (and (procedure? p)
>                     (procedure-arity-includes? p 1))
>                #f
>                p))]
>         [bad-val (ormap nonpredicate? predicates)])
>    (if (not bad-val)
>        (lambda (item) (ormap (lambda (f) (f item)) predicates))
>        (error 'union "not a predicate: ~e" bad-val))))
>
>  
>
>>(snark? (make-foo 'a 'b))
>>    
>>
>#t
>  
>
>>(snark? (make-bar 'c 'b #f))
>>    
>>
>#t
>  
>
>>(snark? 453)
>>    
>>
>#t
>  
>
>>(snark? 'snark)
>>    
>>
>#f
>  
>
>>(snark? "I'm a snark! Honest!")
>>    
>>
>#f
>  
>
>>(define mistake? (union number? cons))
>>    
>>
>union: not a predicate: #<primitive:cons>
>
>Not pretty, but it works.
>
>-jacob
>
>  
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20030419/18a01485/attachment.html>