-
-
Notifications
You must be signed in to change notification settings - Fork 657
/
syntax.rkt
90 lines (73 loc) · 2.56 KB
/
syntax.rkt
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
#lang racket/base
;; owner: ryanc (and cce and stamourv, where noted)
(require racket/syntax
syntax/stx
(for-syntax racket/base))
(provide (rename-out [stx-map syntax-map])
syntax-list
;; by cce:
syntax-source-file-name
syntax-source-directory
;; by stamourv:
format-unique-id
syntax-within?
;; by ryanc
explode-module-path-index
phase-of-enclosing-module)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; By Carl Eastlund, below
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Pattern Bindings
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax-rule (syntax-list template ...)
(syntax->list (syntax (template ...))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Syntax Locations
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (syntax-source-directory stx)
(let* ([source (syntax-source stx)])
(and (path-string? source)
(let-values ([(base file dir?) (split-path source)])
(and (path? base)
(path->complete-path base
(or (current-load-relative-directory)
(current-directory))))))))
(define (syntax-source-file-name stx)
(let* ([f (syntax-source stx)])
(and (path-string? f)
(let-values ([(base file dir?) (split-path f)]) file))))
;; by stamourv:
(define (format-unique-id lctx
#:source [src #f]
#:props [props #f]
#:cert [cert #f]
fmt . args)
((make-syntax-introducer) (apply format-id
lctx #:source src #:props props #:cert cert
fmt args)))
;; is syntax a contained within syntax b, inclusively
(define (syntax-within? a b)
(let ([pos-a (syntax-position a)]
[span-a (syntax-span a)]
[pos-b (syntax-position b)]
[span-b (syntax-span b)])
(and pos-a span-a pos-b span-b
(<= pos-b pos-a)
(>= (+ pos-b span-b) (+ pos-a span-a)))))
;; by ryanc
(define (explode-module-path-index mpi)
(let-values ([(x y) (module-path-index-split mpi)])
(cons x
(if (module-path-index? y)
(explode-module-path-index y)
(list y)))))
(define-syntax-rule (phase-of-enclosing-module)
(variable-reference->module-base-phase
(#%variable-reference)))