Experiment for implementing a custom keyword argument syntax in Chicken Scheme

keyword_macro_experiment.scm

(import matchable
        srfi-48)

(begin-for-syntax
    (import matchable srfi-1)
    (define (keys alist)
        (map car alist))
    
    (define kwarg? list?)
    (define value cdr)

    (define (split-args args)
        (partition kwarg? args))

    (define (lookup obj alist)
        (define res (assq obj alist))
        (if res
            (value res)
            #f))

    (define (check-args args definitions)
        (map (lambda (arg)
                (if (not (member arg definitions))
                    (error (format "Unknown argument ~a" arg))))
             args))
    
    (define (get-values args kwarg-definitions)
        (let-values (((kwargs positional) (split-args args)))
            (check-args (keys kwargs) (keys kwarg-definitions))
            (append positional
                    (map (lambda (kwarg)
                            (or (lookup kwarg kwargs)
                                (lookup kwarg kwarg-definitions)))
                         (keys kwarg-definitions))))))

(define-syntax define*
    (ir-macro-transformer
        (lambda (x r c)
            (match x
                ((_ (name . args) . body)
                 (let-values (((kwargs positional) (split-args args)))
                     `(define-syntax ,name
                        (syntax-rules ()
                            ((_ . args)
                             (apply
                              (lambda (,@positional ,@(keys kwargs))
                                ,@body)
                              (get-values 'args ',kwargs)))))))))))

(define* (x a b c (headers '((Accept application/json))) (uri "https://google.com"))
    (display (list a b c headers uri))
    (display "\n"))

(x 1 2 3)
(x 1 2 3 (uri "https://test"))
(x 1 2 3 (headers '((a b))) (uri "https://test"))
(x 1 (headers '((a b))) 2 3 (uri "https://test"))