#lang scheme/base

(require (for-syntax scheme/base)
         scheme/contract)

; syntax syntax -> boolean
(define (symbolic-identifier=? id1 id2)
  (eq? (syntax->datum id1)
       (syntax->datum id2)))

; syntax (U string symbol number syntax) ... -> syntax
(define (make-id stx . args)
  (datum->syntax stx (string->symbol (apply string-append (map atom->string args)))))

; (_ (define ...) ...)
(define-syntax (begin-for-syntax/any-order stx)
  (define (expand-definition-name stx)
    (syntax-case stx (define)
      [(define (name arg ...) expr ...) #'name]
      [(define name expr)               #'name]))
  (define (expand-definition stx)
    (syntax-case stx (define)
      [(define (name arg ...) expr ...) #'(name (lambda (arg ...) expr ...))]
      [(define name expr)               #'(name expr)]))
  (syntax-case stx ()
    [(_ definition ...)
     (let* ([definitions    (syntax->list #'(definition ...))]
            [names          (map expand-definition-name definitions)]
            [letrec-clauses (map expand-definition definitions)])
       #`(define-values-for-syntax #,names
           (letrec #,letrec-clauses
             (values #,@names))))]))

; Helpers ----------------------------------------

; (U string symbol number syntax) -> string
(define (atom->string atom)
  (cond [(string? atom) atom]
        [(symbol? atom) (symbol->string atom)]
        [(number? atom) (number->string atom)]
        [(syntax? atom) (atom->string (syntax->datum atom))]
        [else (error "Expected (syntax of) (U symbol string number), received: " atom)]))

; Provide statements -----------------------------

(provide begin-for-syntax/any-order)

(provide/contract
 [symbolic-identifier=? (-> syntax? syntax? boolean?)]
 [make-id               (->* ((or/c syntax? false/c)) () #:rest (listof (or/c string? symbol? number? syntax?)) syntax?)])