[racket] About genericity...

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 <kalimehtar at 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.prager at 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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20140403/e1e60463/attachment.html>