(module syntax-utils mzscheme

  (require "require.ss"
           (lib "etc.ss")
           (lib "contract.ss"))
  (require-contract-utils)

  (define (syntax-datum/c datum/c)
    (flat-contract
     (lambda (value)
       (and (syntax? value)
            ((predicate-of datum/c)
             (syntax-object->datum value))))))

  (define (syntax-list/c datum/c)
    (flat-contract
     (lambda (value)
       (and (syntax? value)
            (cond
             [(syntax->list value) =>
              (lambda (stx-list)
                (andmap (predicate-of datum/c) stx-list))]
             [else #f])))))

  (provide/contract
   [syntax-datum/c (flat-contract/c . -> . flat-contract?)]
   [syntax-list/c (flat-contract/c . -> . flat-contract?)]
   [identifier-name=? (identifier? identifier? . -> . boolean?)]
   [syntax-map ((any/c . -> . any/c) (syntax-list/c any/c) . -> .
                (listof any/c))]
   [syntax-append (string? identifier? string? . -> . identifier?)]
   [syntax-prefix (string? identifier? . -> . identifier?)]
   [syntax-suffix (identifier? string? . -> . identifier?)]
   [string->identifier ([string?] [(optional/c syntax?)] . opt-> . identifier?)]
   [identifier->string (identifier? . -> . string?)]
   [identifier->string-literal (identifier? . -> . (syntax/c string?))])

  (provide syntax-case-by-name)

  (define (syntax-map f stx)
    (map f (syntax->list stx)))

  (define (syntax-append prefix id suffix)
    (string->identifier
     (string-append prefix (identifier->string id) suffix)
     id))

  (define (syntax-prefix prefix id)
    (syntax-append prefix id ""))

  (define (syntax-suffix id suffix)
    (syntax-append "" id suffix))

  (define string->identifier
    (opt-lambda (str [stx #f])
      (datum->syntax-object stx (string->symbol str) stx)))

  (define (identifier->string-literal id)
    (datum->syntax-object id (identifier->string id) id))

  (define (identifier->string id)
    (symbol->string (syntax-e id)))

  (define (identifier-name=? one two)
    (symbol=? (syntax-e one) (syntax-e two)))

  (define-syntax (syntax-case-by-name stx)
    (syntax-case stx ()
      [(form arg (id ...) clause ...)
       (andmap identifier? (syntax->list (syntax (id ...))))
       (syntax
        (syntax-case* arg (id ...) identifier-name=?
          clause ...))]))

  )