DSL expansion with variable splicing

complex-dsl.rkt

#lang racket

(require (for-syntax racket syntax/parse racket/syntax syntax/id-table))

(begin-for-syntax

  (define macro-table (make-free-id-table))

  (define (expand-macro id stx)
    (define transformer (syntax-local-value id))
    (define mark (make-syntax-introducer))
    (mark (transformer (mark stx))))

  (define (recursive-expand stx)
    (syntax-parse stx
      [(macro:id . _)
       #:when (dict-has-key? macro-table #'macro)
       (recursive-expand (expand-macro #'macro stx))]
      [(fun:expr arg:expr ...)
       (define/syntax-parse [dsl-arg ...]
         (map recursive-expand (attribute arg)))
       #'(fun dsl-arg ...)]
      [var:id #'(unquote var)]
      [_ stx])))

(define-syntax (dsl stx)
  (syntax-parse stx
    [(_ e:expr)
     (define/syntax-parse template
       (recursive-expand #'e))
     #'(quasiquote template)]))

(define-syntax (define-dsl-syntax stx)
  (syntax-parse stx
    [(_ (name:id . args) body:expr)
     #'(begin
         (define-syntax name
           (syntax-parser [(_ . args) #'body]))
         (begin-for-syntax
           (dict-set! macro-table (quote-syntax name) #t)))]))

(module+ test
  (require rackunit)

  (define-dsl-syntax (pred? x) (> 3 x))

  (check-equal?
    (dsl (or (< 10 "x") (pred? "y")))
    '(or (< 10 "x") (> 3 "y")))

  (define-dsl-syntax (other? x) (or (= 2 x) (= 3 x)))

  (check-equal?
    (dsl (or (other? "x") (other? "y")))
    '(or (or (= 2 "x") (= 3 "x"))
       (or (= 2 "y") (= 3 "y"))))

  ;; example 1
  (define-dsl-syntax (pred1? x1) (or (= 2 x1) (> x1 3)))
  (check-equal?
    (dsl (pred1? 1))
    '(or (= 2 1) (> 1 3)))

  ;; example 2
  (define y2 3)
  (define-dsl-syntax (pred2? x2) (or (= 2 x2) (> x2 y2)))
  (check-equal?
    (dsl (pred2? 1))
    '(or (= 2 1) (> 1 3)))

  ;; example 3
  (define x3 3)
  (define y3 3)
  (define-dsl-syntax (pred3? x3) (or (= 2 x3) (> x3 y3)))
  (check-equal?
    (dsl (pred3? 1))
    '(or (= 2 1) (> 1 3)))

  ;; example 4
  (define-dsl-syntax (pred4? x4) (or (= 2 x4) (> x4 z4)))
  #;(check-exn exn:fail:syntax?
    (lambda () (dsl (pred4? 1)))))