Decorators in racket

Show & Tell
1

I am wondering if there's a tool similar to Python's decorators in Racket
Unfortunetely I couldn't find one.
So I made one myself

#lang racket


(define-syntax (define-decorator stx)
  (syntax-case stx ()
    [(_ (dector EXEC_RESULT) body ...)
     (with-syntax ([new-body (rewrite-lambda #'(body ...) #'EXEC_RESULT #'fun)])
       (displayln #'new-body)
       #`(define (dector fun)
           new-body))]))

(define-for-syntax (rewrite-lambda stx EXEC_RESULT fun)
  (define body (rewrite stx EXEC_RESULT fun))
  #`(make-keyword-procedure (lambda (kws kw-args . args) #,@(syntax->list body))))

(define-for-syntax (rewrite stx EXEC fun)
  (syntax-case stx ()
    [(a . b) #`(#,(rewrite #'a EXEC fun) . #,(rewrite #'b EXEC fun))]
    [a
     (if (and (identifier? #'a) (free-identifier=? #'a EXEC))
         #'(keyword-apply fun kws kw-args args)
         #'a)]
    [else stx]))

You can use it as shown blow

;;define a decorator called begin-end
(define-decorator (begin-end EXEC_RESULT) (displayln "begin") EXEC_RESULT (displayln "end"))

;;decorate a function, eg. pretty-print
(require racket/pretty)
(define begin-end-pretty-print (begin-end pretty-print))

;;call the decorated function begin-end-pretty-print
(begin-end-pretty-print (+ 1 1) #:newline? #t)

I hope this can help others.
If there's a better approach or an existing library that already implements this functionality, please let me know!

2 Likes
2

Did you consider the following:

(define-syntax (define-decorator stx)
  (syntax-case stx ()
    [(_ (dector EXEC_RESULT) body ...)
     #`(define (dector fun)
         (make-keyword-procedure
          (lambda (kws kw-args . args)
            (let-syntax ([EXEC_RESULT
                          (lambda (stx)
                            (syntax-case stx ()
                              [a (identifier? #'a)
                                 #'(keyword-apply fun kws kw-args args)]))])
              body ...))))]))
2 Likes
3

Also, your particular use of a decorator is similar to what "racket/trace" accomplishes. The library provides hooks for tailoring the trace to your needs.

4

That's neater—thanks for the improvement!
By the way, is (identifier? #'a) necessary here? Can it be safely removed?

For example:

(define-syntax (define-decorator stx)
  (syntax-case stx ()
    [(_ (dector EXEC_RESULT) body ...)
     #`(define (dector fun)
         (make-keyword-procedure
          (lambda (kws kw-args . args)
            (let-syntax ([EXEC_RESULT
                          (lambda (stx)
                            #'(keyword-apply fun kws kw-args args))])
              body ...))))]))
5

Thanks for your suggestion! However, I'm looking for a more general decorator mechanism, rather than something specifically intended for tracing or debugging.

6

Hi, @luistung.

This is really cool; definitely one of my favourite bits of Python syntax. I cut my teeth on higher-order functions with the old snake.

This is kind of a hacky attempt which doesn't really enforce any constraints on the positioning of the decorators, and it is slightly less general perhaps in its approach to the decorator functions themselves, but I'm sure others will have brighter ideas regarding a more "Racket-ey" version of things.

#lang racket/base

(require
  racket/stxparam
  (for-syntax
   racket/base
   racket/syntax
   syntax/parse
   syntax/parse/lib/function-header))

(define-for-syntax none (gensym))
(define-syntax (define-syntax-parameter/parameter stx)
  (syntax-case stx ()
    [(_ name init)
     (with-syntax ([param (format-id stx "the-~a" #'name #:subs? #true)]
                   [fresh (format-id stx   "a-~a" #'name #:subs? #true)])
       #'(begin
           (define-syntax-parameter name (make-parameter init))
           (begin-for-syntax
             (define (param [ex none])
               (define param (syntax-parameter-value #'name))
               (if (eq? none ex) {param} {param ex}))
             (define (fresh [ex init]) (make-parameter ex)))))]))

(define-syntax-parameter/parameter stack #false)

(begin-for-syntax
  (define (no-stack-error)
    (raise-syntax-error
     'decorator "the decorator stack has not been created"))
  
  (define (on-stack-error)
    (raise-syntax-error
     'decorator "the decorator stack has not been cleared"
     (map syntax->datum {the-stack})))
  
  (define (undecorated?) (null? {the-stack}))
  
  (define (push fun)
    {the-stack (cons fun {the-stack})})
  
  (define (pull fun)
    (define decor {the-stack})
    ({the-stack #false}
     . and . #`(compose #,@decor #,fun))))

(define-syntax (@ stx)
  (syntax-case stx ()
    [[_ #:decorate]
     (when   {the-stack} (on-stack-error))
     ({the-stack null} . and . #'(void))]
    
    [[_ fun]
     (unless {the-stack} (no-stack-error))
     ((push #'fun) . and . #'(void fun))]))

(define-syntax (define@ stx)
  (syntax-parse stx
    [(_ head:function-header . body)
     
     #:fail-when (undecorated?)
     "expected at least one decorator, found none"

     #:with wrap #'(syntax-parameterize ([stack (a-stack)]) . body)
     #`(define head.name
         (let () (define head wrap) #,(pull #'head.name)))]))

(define ((couch type) room)
  (hash-set room 'couch type))

(define ((curtains type) room)
  (hash-set room 'curtains type))

(define ((rug type) room)
  (hash-set room 'rug type))

[@ #:decorate]
[@ (couch "leather")]
[@ (curtains "all the flowers")]
[@ (rug "faded persian")]
(define@ (living-room)
  (hasheq 'room "living-room"))

(living-room)
;=> '#hasheq((couch . "leather")
;            (curtains . "all the flowers")
;            (room . "living-room")
;            (rug . "faded persian"))

(define (square x) (* x x))
(define (double x) (* 2 x))
(define (triple x) (* 3 x))

[@ #:decorate]
[@ triple]
[@ square]
(define@ (number-1) 1)

(number-1)
;=> 9

[@ #:decorate]
[@ square]
[@ triple]
(define@ (number-2) 2)

(number-2)
;=> 12

(define ((pre/post pre post) fun)
  (pre) (fun) (post))

[@ #:decorate]
[@ (pre/post
    (lambda _ (println "pre"))
    (lambda _ (println "post")))]
(define@ ((test say))
  (println say))

(test "middle")
;=> "pre"
;=> "middle"
;=> "post"

[@ #:decorate]
[@ square]
[@ double]
(define@ (number-3)
  [@ #:decorate]
  [@ triple]
  (define@ (three) 1)
  
  [@ #:decorate]
  [@ double]
  (define@ (two) 1)
  
  (* (three) (two)))

(number-3)
;=> 72

(define ((fork n) x) (apply values (build-list n (λ _ x))))

[@ #:decorate]
[@ (fork 2)] [@ list]
[@ (fork 3)] [@ list]
[@ (fork 4)] [@ list]
(define@ (spread) null)

(spread)
;=> '(((() ()) (() ()) (() ()))
;     ((() ()) (() ()) (() ()))
;     ((() ()) (() ()) (() ()))
;     ((() ()) (() ()) (() ())))

Thanks for sharing--great for tinkering on a Saturday :racket_heart:

Edit: just cleaned up the messiness a bit.

2 Likes
7

However, I'm looking for a more general decorator mechanism, rather than something specifically intended for tracing or debugging.

One general building block for wrapping functions (to implement "advice"/"decorator"/"aspect-oriented-programming") is an impersonator.

1 Like
8

p.s. Having pointed out impersonators, I have to say: Every time I've done some flavor of advice/trace/decorator/AOP ... I've either "just" used function composition, or, written the kind of sugar macro you were already discussing.

p.p.s. My guess is the history/motivation of impersonators is connected to Racket contracts. But that's just my guess and maybe there's a more interesting story.

9

On Mar 16, 2025, at 9:03 AM, Greg Hendershott via Racket Discourse notifications@racket.discoursemail.com questioned whether "the history/motivation of impersonators is connected to Racket contracts.”

This is indeed correct. The impetus is due to Strickland, whose dissertation goal was to expand the contract system to classes, objects, etc. Since those are mutable, we also had to figure out a story for mutable values such as vectors. One days S. came to my office to explain how our “lambda wrapping approach” (which works for first-class classes, too) just wouldn’t work out. “We need two kinds of basic wrappers that protect values: chaperones and impersonators.” — Matthew and Sam and Robby were visiting soon after, and it turned out, they had similar ideas, but unlike S. none had acted on it. Once Matthew baked this wrappers into Racket, their general applicability became clear and the contract system could finally cope with mutable values such as vectors properly.

— Matthias

5 Likes