Is this sort of like what you mean?:
(define dup (my-match-lambda*))
(my-match-lambda-add-clause! dup [(list (? string? s)) (string-append s s)])
(my-match-lambda-add-clause! dup [(list (? integer? n)) (list n n)])
(check-equal? (dup "Hello") "HelloHello")
(check-equal? (dup 10) '(10 10))
Here’s the code:
#lang racket
(provide my-match-lambda*
(struct-out my-match-lambda-procedure)
my-match-lambda-append
my-match-lambda-add-clause!
my-match-lambda-add-overriding-clause!
(struct-out exn:fail:my-match-lambda:no-match)
(struct-out exn:fail:my-match-lambda:no-match:next-clause)
raise-my-match-lambda:no-match-error)
(module+ test
(require rackunit)
(define dup (my-match-lambda*))
(my-match-lambda-add-clause! dup [(list (? string? s)) (string-append s s)])
(my-match-lambda-add-clause! dup [(list (? integer? n)) (list n n)])
(check-equal? (dup "Hello") "HelloHello")
(check-equal? (dup 10) '(10 10))
)
(define-syntax-rule (my-match-lambda* clause ...)
(my-match-lambda-procedure
(list (clause->proc clause) ...)))
(define-syntax-rule (clause->proc clause)
(match-lambda* clause [args (raise-my-match-lambda:no-match-error args)]))
(struct my-match-lambda-procedure (procs)
#:transparent #:mutable
#:property prop:procedure
(lambda (this . args)
(let ([procs (my-match-lambda-procedure-procs this)])
(define proc (apply my-match-lambda-append procs))
(apply proc args))))
(define within-my-match-lambda-append?
(make-parameter #f))
(define my-match-lambda-append
(case-lambda
[() (case-lambda)]
[(f) f]
[(f1 f2) (lambda args
(with-handlers ([exn:fail:my-match-lambda:no-match:next-clause?
(λ (e) (apply f2 args))])
(parameterize ([within-my-match-lambda-append? #t])
(apply f1 args))))]))
(define-syntax-rule (my-match-lambda-add-clause! proc clause ...)
(set-my-match-lambda-procedure-procs! proc
(append
(my-match-lambda-procedure-procs proc)
(list (clause->proc clause)
...))))
(define-syntax-rule (my-match-lambda-add-overriding-clause! proc clause ...)
(set-my-match-lambda-procedure-procs! proc
(append (list (clause->proc clause) ...)
(my-match-lambda-procedure-procs proc))))
(struct exn:fail:my-match-lambda:no-match exn:fail (args) #:transparent)
(struct exn:fail:my-match-lambda:no-match:next-clause
exn:fail:my-match-lambda:no-match () #:transparent)
(define (raise-my-match-lambda:no-match-error args)
(define message
(string-append
"my-match-lambda: no clause matches" "\n"
" args: "(~v args)""))
(define error-exn
(with-handlers ([exn:fail? identity])
(error message)))
(define exn
(cond [(within-my-match-lambda-append?)
(exn:fail:my-match-lambda:no-match:next-clause
message (exn-continuation-marks error-exn) args)]
[else
(exn:fail:my-match-lambda:no-match
message (exn-continuation-marks error-exn) args)]))
(raise exn))
tnh
On Apr 3, 2014, at 5:43 AM, Roman Klochkov <kalimeh...@mail.ru> wrote:
> Or even simpler
>
> (define (dup a)
> (cond
> [(string? a) (string-append a a)]
> [(integer? a) (list a a)])
>
> :-)
>
> I think, Alejandro wanted to add clauses in different places (generic in one
> module, added method in another, for example).
>
>
> Thu, 3 Apr 2014 20:11:36 +1100 от Daniel Prager <daniel.a.pra...@gmail.com>:
> Here's an out-of-the-box option, using Racket's pattern matching with the (?
> predicate) form:
>
> (define/match (dup a)
> [((? string?)) (string-append a a)]
> [((? integer?)) (list a a)])
>
> Dan
> ____________________
> Racket Users list:
> http://lists.racket-lang.org/users
>
>
>
> --
> Roman Klochkov
> ____________________
> Racket Users list:
> http://lists.racket-lang.org/users
____________________
Racket Users list:
http://lists.racket-lang.org/users
