#lang racket/base

(require racket/match
         syntax/parse
         (for-syntax racket/base
                     racket/syntax
                     racket/list
                     racket/struct
                     syntax/parse
                     racket/private/sc)
         ;; attribute-mapping? is provided for-syntax
         (only-in syntax/parse/private/residual attribute-mapping?))

(provide auto-with-syntax)
(provide auto-syntax)
(provide auto-syntax-case)

(define (leaves->datum e depth)
  (if (> depth 0)
      (map (λ (eᵢ) (leaves->datum eᵢ (sub1 depth))) e)
      (if (syntax? e)
          (syntax->datum e)
          e)))
        

(define-syntax (to-datum stx)
  (syntax-case stx ()
    [(_ id)
     (syntax-pattern-variable? (syntax-local-value #'id (λ () #f)))
     (begin
       (let* ([mapping (syntax-local-value #'id)]
              [valvar (syntax-mapping-valvar mapping)]
              [depth (syntax-mapping-depth mapping)])
         (if (attribute-mapping? (syntax-local-value valvar (λ () #f)))
             #`(leaves->datum (attribute id) #,depth)
             #`(leaves->datum #,valvar #,depth))))]))

(begin-for-syntax
  (define-values (struct:auto-pvar
                  make-auto-pvar
                  auto-pvar?
                  auto-pvar-ref
                  auto-pvar-set!)
    (make-struct-type 'auto-pvar
                      (eval #'struct:syntax-mapping
                            (module->namespace 'racket/private/sc))
                      0
                      0
                      #f
                      null
                      (current-inspector)
                      (λ (self stx)
                        #`(to-datum #,stx)))))

(define-for-syntax (syntax->tree/ids e)
  (cond [(identifier? e) e]
        [(syntax? e) (syntax->tree/ids (syntax-e e))]
        [(pair? e) (cons (syntax->tree/ids (car e))
                         (syntax->tree/ids (cdr e)))]
        [(vector? e) (map syntax->tree/ids (vector->list e))]
        [(box? e) (syntax->tree/ids (unbox e))]
        [(prefab-struct-key e) (map syntax->tree/ids (struct->list e))]
        [else e]))

(define-for-syntax (syntax->ids e)
  (filter identifier? (flatten (syntax->tree/ids e))))

(define-syntax auto-syntax
  (syntax-parser
    [(_ (id ...) body ...)
     #:with (pvar-id ...) (filter (λ (id)
                                    (syntax-pattern-variable?
                                     (syntax-local-value id (λ () #f))))
                                  (syntax->list #'(id ...)))
     (with-disappeared-uses
      (let ()
        (record-disappeared-uses (syntax->list #'(pvar-id ...)))
        #'(let-syntax ([pvar-id
                        (make-set!-transformer
                         (let ([mapping (syntax-local-value
                                         (quote-syntax pvar-id))])
                           (make-auto-pvar (syntax-mapping-depth mapping)
                                           (syntax-mapping-valvar mapping))))]
                       ...)
            body ...)))]))

(define-syntax auto-with-syntax
  (syntax-parser
    [(_ ([pat e] ...) body ...)
     #:with (id ...) (syntax->ids #'(pat ...))
     #'(with-syntax ([pat e] ...)
         (auto-syntax (id ...)
           body ...))]))


(define-syntax auto-syntax-case
  (syntax-parser
    [(_ stx-expression literals [pat guard+body ...] ...)
     #:with (id ...) (syntax->ids #'(pat ...))
     #'(syntax-case stx-expression literals
         [pat (auto-syntax (id ...)
                guard+body ...)]
         ...)]))