<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
  <meta http-equiv="Content-Type" content="text/html;charset=ISO-8859-1">
  <title></title>
</head>
<body>
<tt>Or you can use (define-union snark (foo bar number) like this:<br>
<br>
(define-macro define-union<br>
&nbsp; (lambda (name types)<br>
&nbsp;&nbsp;&nbsp; (if (not (list? tu<br>
&nbsp; &nbsp; (define (add-? s)<br>
</tt><tt>&nbsp;&nbsp;&nbsp; &nbsp; (if (not (symbol? s))<br>
&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp; (error 'define-union "~a is not a data type" s))<br>
&nbsp;&nbsp;&nbsp; &nbsp; (string-&gt;symbol (string-append (symbol-&gt;string s) "?")))</tt><br>
<tt>&nbsp; &nbsp; (let ([discriminators (map add-? types)]<br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; [final-descriminator (add-? name)])<br>
&nbsp;&nbsp;&nbsp; &nbsp; (define (with-handlers-discriminators)<br>
&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; (define (iter discs)<br>
&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp; (if (empty? discs)<br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; empty<br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; (cons `(with-handlers ([exn? (lambda args (error
'define-union "~a is not a data type discriminator"<br>
&nbsp;&nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp; &nbsp; ,(car
discs)))])<br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;,(car discs))<br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; (iter (cdr discs)))))<br>
&nbsp; &nbsp; &nbsp; &nbsp; (cons `list (iter discriminators)))<br>
&nbsp; &nbsp; &nbsp; `(define ,final-descriminator<br>
&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;(let ([discs ,(with-handlers-discriminators)])<br>
&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp; &nbsp;(define (check-discriminator f)<br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;(if (not (and (procedure? f)<br>
&nbsp; &nbsp; &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp; &nbsp; &nbsp; (procedure-arity-includes? f 1))) ; checks
that can be called with one argument<br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;(error 'define-union "~a is not a data type
discriminator" f)))<br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;(for-each check-discriminator discs)<br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;(lambda (data)<br>
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;(ormap (lambda (disc) (disc data)) discs)))))))<br>
<br>
<br>
Hope there aren't any missing parens.</tt><br>
<br>
<br>
Jacob Matthews wrote:<br>
<blockquote type="cite"
 cite="[email protected]u">
  <pre wrap="">  For list-related administrative tasks:
  <a class="moz-txt-link-freetext" href="http://list.cs.brown.edu/mailman/listinfo/plt-scheme">http://list.cs.brown.edu/mailman/listinfo/plt-scheme</a>

On Fri, 18 Apr 2003, Anton van Straaten wrote:

  </pre>
  <blockquote type="cite">
    <pre wrap="">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.

    </pre>
  </blockquote>
  <pre wrap=""><!---->
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?))

  </pre>
  <blockquote type="cite">
    <pre wrap="">(snark? (make-foo 'a 'b))
    </pre>
  </blockquote>
  <pre wrap=""><!---->#t
  </pre>
  <blockquote type="cite">
    <pre wrap="">(snark? (make-bar 'c 'b #f))
    </pre>
  </blockquote>
  <pre wrap=""><!---->#t
  </pre>
  <blockquote type="cite">
    <pre wrap="">(snark? 453)
    </pre>
  </blockquote>
  <pre wrap=""><!---->#t
  </pre>
  <blockquote type="cite">
    <pre wrap="">(snark? 'snark)
    </pre>
  </blockquote>
  <pre wrap=""><!---->#f
  </pre>
  <blockquote type="cite">
    <pre wrap="">(snark? "I'm a snark! Honest!")
    </pre>
  </blockquote>
  <pre wrap=""><!---->#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))))

  </pre>
  <blockquote type="cite">
    <pre wrap="">(snark? (make-foo 'a 'b))
    </pre>
  </blockquote>
  <pre wrap=""><!---->#t
  </pre>
  <blockquote type="cite">
    <pre wrap="">(snark? (make-bar 'c 'b #f))
    </pre>
  </blockquote>
  <pre wrap=""><!---->#t
  </pre>
  <blockquote type="cite">
    <pre wrap="">(snark? 453)
    </pre>
  </blockquote>
  <pre wrap=""><!---->#t
  </pre>
  <blockquote type="cite">
    <pre wrap="">(snark? 'snark)
    </pre>
  </blockquote>
  <pre wrap=""><!---->#f
  </pre>
  <blockquote type="cite">
    <pre wrap="">(snark? "I'm a snark! Honest!")
    </pre>
  </blockquote>
  <pre wrap=""><!---->#f
  </pre>
  <blockquote type="cite">
    <pre wrap="">(define mistake? (union number? cons))
    </pre>
  </blockquote>
  <pre wrap=""><!---->union: not a predicate: #&lt;primitive:cons&gt;

Not pretty, but it works.

-jacob

  </pre>
</blockquote>
</body>
</html>