blob: a5fbb2707ed0bef9901d7d5ec0983893604836f0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BASE.plt - common routines that are shared by all other bzlib modules
;;
;; in a way, base.plt is the most fundamental module of the whole bzlib stack
;; and as such it also is the lowest level code. We are not likely to
;; fix the code any time soon, and hence any of the functions here are
;; explicitly likely to be obsoleted or moved elsewhere.
;;
;; Proceed with caution.
;;
;;
;; Bonzai Lab, LLC. All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; synatx.ss - syntax helpers
;; yc 10/19/2009 - first version
;; yc 7/6/2010 - fixed syntax-identifier-append
(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? lst) (error 'syntax-identifier-append "no stx for context"))
((syntax? (car lst)) (car lst))
(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))
|
