Fix syntax depth calculation

This commit is contained in:
Asumu Takikawa 2016-05-12 18:23:38 -04:00
parent 2c5bf77f1c
commit 83f6f11496
3 changed files with 14 additions and 5 deletions

View File

@ -168,19 +168,21 @@ The module implements code coverage annotations as described in cover.rkt
;; Syntax -> Natural
;; Maxiumum depth of begin-for-syntaxes
(define (get-syntax-depth expr)
(kernel-syntax-case
(disarm expr) #f
(define (get-syntax-depth expr [phase 0])
(kernel-syntax-case/phase
(disarm expr) phase
[(module _ _ mb)
(get-syntax-depth #'mb)]
[(module* _ _ mb)
(get-syntax-depth #'mb)]
[(begin-for-syntax b ...)
(add1 (apply max 1 (map get-syntax-depth (syntax->list #'(b ...)))))]
(add1 (apply max 1 (for/list ([b (in-list (syntax->list #'(b ...)))])
(get-syntax-depth b (add1 phase)))))]
[(define-syntaxes a ...)
2]
[(b ...)
(apply max 1 (map get-syntax-depth (syntax->list #'(b ...))))]
(apply max 1 (for/list ([b (in-list (syntax->list #'(b ...)))])
(get-syntax-depth b phase)))]
[_ 1]))
;; Natural PathString Symbol -> Syntax

View File

@ -0,0 +1,6 @@
#lang racket/base
(require (for-meta 1 racket/base)
(for-meta 2 racket/base))
(begin-for-syntax (define-syntax x #f))

View File

@ -6,6 +6,7 @@
(define-runtime-path-list others
(list "bfs+module-nolex.rkt"
"bfs+module.rkt"
"bfs+define-syntax.rkt"
"lazy-require.rkt"))
(test-case
"begin-for-syntax with modules should be okay"