1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
#lang racket/base
(require racket/contract
racket/match
(for-syntax racket/base))
(define (make-coerce-safe? coerce)
(lambda (x)
(with-handlers ([exn:fail? (lambda (x) #f)])
(and (coerce x) #t))))
(define-syntax (define-coercion-match-expander stx)
(syntax-case stx ()
[(_ expander-id test? coerce)
(syntax/loc stx
(define-match-expander expander-id
(lambda (stx)
(syntax-case stx ()
[(_ id) (identifier? #'id)
(syntax/loc stx
(? test? (app coerce id)))]))))]))
(provide/contract
[make-coerce-safe? ((any/c . -> . any/c) . -> . (any/c . -> . boolean?))])
(provide
define-coercion-match-expander)
|
