#lang scheme/base
(require (for-syntax scheme/base)
syntax/stx scheme/string mzlib/trace
scheme/contract
)
(define (syntax-map proc stx-lst)
(syntax-case stx-lst ()
(() #'())
((id . rest)
#`(#,(proc #'id) . #,(syntax-map proc #'rest)))))
(define (syntax-identifier-append arg #:stx (stx #f) . args)
(define (get-first-syntax lst)
(define (helper lst)
(cond ((null? args) (error 'syntax-identifier-append "no stx for context"))
((syntax? (car args)) (car args))
(else (helper (cdr lst)))))
(if (not stx) (helper lst) stx))
(define (->string x)
(cond ((syntax? x) (->string (syntax->datum x)))
(else (format "~a" x))))
(define (helper args)
(datum->syntax (get-first-syntax args)
(string->symbol (string-join (map ->string args) ""))))
(helper (cons arg args)))
(define (syntax-id-part? stx)
(define (helper part)
(or (symbol? part) (bytes? part) (string? part) (number? part)))
(or (and (syntax? stx)
(helper (syntax->datum stx)))
(helper stx)))
(provide/contract
(syntax-map (-> (-> any/c any) stx-pair? any))
(syntax-identifier-append (->* (syntax-id-part?)
(#:stx syntax?)
#:rest (listof syntax-id-part?)
syntax?))
)
(provide (all-from-out syntax/stx))