#lang scheme/base

(require scheme/contract)

(define ((expand-keyword message) stx)
  (raise-syntax-error #f message stx))

(define refresh-identifier
  (compose syntax-local-introduce syntax-local-get-shadower))

(define-struct syntax-meta (value transformer)
  #:property prop:procedure (struct-field-index transformer))

(define (syntax->meta id
                      #:message [msg "not a syntactic meta-value"]
                      #:source [stx #f])

  (define (err)
    (raise-syntax-error
     #f
     (format "~a: ~s" msg (syntax->datum id))
     (or stx id) id))

  (let* ([meta (syntax-local-value id err)])
    (if (syntax-meta? meta)
        (syntax-meta-value meta)
        (err))))

(provide/contract
 [expand-keyword (-> string? (-> syntax? syntax?))]
 [refresh-identifier (-> identifier? identifier?)]
 [syntax-meta? (-> any/c boolean?)]
 [make-syntax-meta (-> any/c (-> syntax? syntax?) syntax-meta?)]
 [syntax-meta-transformer (-> syntax-meta? (-> syntax? syntax?))]
 [syntax-meta-value (-> syntax-meta? any/c)]
 [syntax->meta
  (->* [identifier?]
       [#:message string? #:source (or/c syntax? #f)]
       any/c)])