suzanne.soy/stxparse-info
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

ok debug

Browse Source
This commit is contained in:
Suzanne Soy 2021-04-04 05:02:08 +01:00
parent 8f6ef38a5e
commit 3177410987
3 changed files with 7 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
8-0/racket/collects/syntax/parse/private/parse.rkt
View File

@ -435,12 +435,7 @@ Conventions:
((body-sequence) ((body-sequence)
(syntax-case rest () (syntax-case rest ()
[(e0 e ...) [(e0 e ...)
;; Should we use a shadower (works on the whole file, unhygienically), #'(let () e0 e ...)]
;; or use the context of the syntax-parse identifier?
(let ([the-#%intdef-begin (datum->syntax #'ctx '#%intdef-begin)])
(if (syntax-local-value the-#%intdef-begin (λ () #f)) ;; Defined as a macro
#`(let () (#,the-#%intdef-begin e0 e ...))
#'(let () e0 e ...)))]
[_ (raise-syntax-error #f "expected non-empty clause body" [_ (raise-syntax-error #f "expected non-empty clause body"
#'ctx clause)])) #'ctx clause)]))
(else (else

6
8-0/racket/collects/syntax/parse/private/residual.rkt
View File

@ -10,7 +10,7 @@
(require (for-syntax racket/private/sc syntax/parse/private/residual-ct)) (require (for-syntax racket/private/sc syntax/parse/private/residual-ct))
(provide (for-syntax (all-from-out syntax/parse/private/residual-ct))) (provide (for-syntax (all-from-out syntax/parse/private/residual-ct)))
(require "../../case/template.rkt") (require racket/private/template)
(provide (for-syntax attribute-mapping attribute-mapping?)) (provide (for-syntax attribute-mapping attribute-mapping?))
;; ============================================================ ;; ============================================================
@ -18,9 +18,7 @@
(require "runtime-progress.rkt" (require "runtime-progress.rkt"
"3d-stx.rkt" "3d-stx.rkt"
auto-syntax-e syntax/stx)
syntax/stx
stxparse-info/current-pvars)
(provide (all-from-out "runtime-progress.rkt") (provide (all-from-out "runtime-progress.rkt")

12
8-0/racket/collects/syntax/parse/private/runtime.rkt
View File

@ -1,13 +1,11 @@
#lang racket/base #lang racket/base
(require racket/stxparam (require racket/stxparam
stxparse-info/parse/private/residual ;; keep abs. path stxparse-info/parse/private/residual ;; keep abs. path
stxparse-info/current-pvars
(for-syntax racket/base (for-syntax racket/base
racket/list racket/list
syntax/kerncase syntax/kerncase
syntax/strip-context syntax/strip-context
racket/private/sc racket/private/sc
auto-syntax-e/utils
racket/syntax racket/syntax
syntax/parse/private/rep-data)) syntax/parse/private/rep-data))
@ -113,10 +111,9 @@ residual.rkt.
...) ...)
([(vtmp) value] ...) ([(vtmp) value] ...)
(letrec-syntaxes+values (letrec-syntaxes+values
([(name) (make-auto-pvar 'depth (quote-syntax stmp))] ...) ([(name) (make-syntax-mapping 'depth (quote-syntax stmp))] ...)
() ()
(with-pvars (name ...) . body))))]))
. body)))))]))
;; (let-attributes* (([id num] ...) (expr ...)) expr) : expr ;; (let-attributes* (([id num] ...) (expr ...)) expr) : expr
;; Special case: empty attrs need not match number of value exprs. ;; Special case: empty attrs need not match number of value exprs.
@ -150,9 +147,8 @@ residual.rkt.
(attribute-mapping (quote-syntax vtmp) 'name 'depth (attribute-mapping (quote-syntax vtmp) 'name 'depth
(if 'syntax? #f (quote-syntax check-attr-value)))) (if 'syntax? #f (quote-syntax check-attr-value))))
... ...
(define-syntax name (make-auto-pvar 'depth (quote-syntax stmp))) (define-syntax name (make-syntax-mapping 'depth (quote-syntax stmp)))
... ...)))]))
(define-pvars name ...))))]))
(define-syntax-rule (phase-of-enclosing-module) (define-syntax-rule (phase-of-enclosing-module)
(variable-reference->module-base-phase (variable-reference->module-base-phase