Define values which ignores excess values

gistfile1.rkt

#lang racket


(define-syntax (my-define-values stx)
  (syntax-case stx ()
    ((_ (ids ...) expression)
     (with-syntax (((indices ...)
                    (datum->syntax stx
                                   (build-list (length
                                                (syntax->list #'(ids ...)))
                                               (lambda (n) n)))))
       #'(define-values (ids ...)
           (call-with-values
               (lambda () expression)
             (lambda args
               (values (list-ref args indices) ...))))))))

(my-define-values (a b c) (values 1 2 3 4))

(equal? a 1)
(equal? b 2)
(equal? c 3)

(my-define-values (d) (values 'foo 'bar 'baz))

(equal? d 'foo)

(define (foo a b)
  (values a b))

(my-define-values (result) (foo 1 2))

(equal? result 1)