<!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>
(lambda (name types)<br>
(if (not (list? tu<br>
(define (add-? s)<br>
</tt><tt> (if (not (symbol? s))<br>
(error 'define-union "~a is not a data type" s))<br>
(string->symbol (string-append (symbol->string s) "?")))</tt><br>
<tt> (let ([discriminators (map add-? types)]<br>
[final-descriminator (add-? name)])<br>
(define (with-handlers-discriminators)<br>
(define (iter discs)<br>
(if (empty? discs)<br>
empty<br>
(cons `(with-handlers ([exn? (lambda args (error
'define-union "~a is not a data type discriminator"<br>
,(car
discs)))])<br>
,(car discs))<br>
(iter (cdr discs)))))<br>
(cons `list (iter discriminators)))<br>
`(define ,final-descriminator<br>
(let ([discs ,(with-handlers-discriminators)])<br>
(define (check-discriminator f)<br>
(if (not (and (procedure? f)<br>
(procedure-arity-includes? f 1))) ; checks
that can be called with one argument<br>
(error 'define-union "~a is not a data type
discriminator" f)))<br>
(for-each check-discriminator discs)<br>
(lambda (data)<br>
(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="midPine.LNX.4.50.0304182111410.21748-100000@randal.cs.uchicago.edu">
<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: #<primitive:cons>
Not pretty, but it works.
-jacob
</pre>
</blockquote>
</body>
</html>