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

syntax/parse: speed up "is literal bound?" check

Browse Source 
Can't do check completely statically, because phase of comparison
is expression (and even default is slightly unpredictable).
So instead compute whether check would succeed for likely phase
offsets, and use list of ok offsets as run-time fast path (memv
instead of identifier-binding).
This commit is contained in:
Ryan Culpepper 2011-09-06 04:28:11 -06:00
parent 68e76a9876
commit 3aa16f2c26
2 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/syntax/parse/private/rep.rkt
View File

@ -2,8 +2,7 @@
(require (for-template racket/base (require (for-template racket/base
racket/stxparam racket/stxparam
"keywords.rkt" "keywords.rkt"
"runtime.rkt" "runtime.rkt")
(only-in unstable/syntax phase-of-enclosing-module))
racket/contract/base racket/contract/base
"minimatch.rkt" "minimatch.rkt"
syntax/id-table syntax/id-table
@ -1301,10 +1300,7 @@ A syntax class is integrable if
;; check-literal-entry : stx stx -> (list id id ct-phase ct-phase) ;; check-literal-entry : stx stx -> (list id id ct-phase ct-phase)
(define (check-literal-entry stx ctx) (define (check-literal-entry stx ctx)
(define (go internal external phase) (define (go internal external phase)
(txlift #`(check-literal (quote-syntax #,external) (txlift #`(check-literal #,external #,phase #,ctx))
#,phase
(phase-of-enclosing-module)
(quote-syntax #,ctx)))
(list internal external phase phase)) (list internal external phase phase))
(syntax-case stx () (syntax-case stx ()
[(internal external #:phase phase) [(internal external #:phase phase)

31
collects/syntax/parse/private/runtime.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base #lang racket/base
(require racket/list (require racket/list
racket/stxparam racket/stxparam
unstable/syntax
"runtime-progress.rkt" "runtime-progress.rkt"
"runtime-failure.rkt" "runtime-failure.rkt"
(for-syntax racket/base (for-syntax racket/base
@ -257,15 +258,33 @@
(provide check-literal (provide check-literal
free-identifier=?/phases) free-identifier=?/phases)
;; check-literal : id phase-level phase-level stx -> void ;; (check-literal id phase-level-expr ctx) -> void
;; FIXME: change to normal 'error', if src gets stripped away (define-syntax (check-literal stx)
(define (check-literal id abs-phase mod-phase ctx) (syntax-case stx ()
(unless (identifier-binding id abs-phase) [(check-literal id used-phase-expr ctx)
(let* ([ok-phases/ct-rel
;; id is bound at each of ok-phases/ct-rel
;; (phase relative to the compilation of the module in which the
;; 'syntax-parse' (or related) form occurs)
(filter (lambda (p) (identifier-binding #'id p)) '(0 1 -1 #f))])
;; so we can avoid run-time call to identifier-binding if
;; (+ (phase-of-enclosing-module) ok-phase/ct-rel) = used-phase
(with-syntax ([ok-phases/ct-rel ok-phases/ct-rel])
#'(check-literal* (quote-syntax id)
used-phase-expr
(phase-of-enclosing-module)
'ok-phases/ct-rel
(quote-syntax ctx))))]))
(define (check-literal* id used-phase mod-phase ok-phases/ct-rel ctx)
(unless (or (memv (and used-phase (- used-phase mod-phase))
ok-phases/ct-rel)
(identifier-binding id used-phase))
(raise-syntax-error (raise-syntax-error
#f #f
(format "literal is unbound in phase ~a (phase ~a relative to the enclosing module)" (format "literal is unbound in phase ~a (phase ~a relative to the enclosing module)"
abs-phase used-phase
(and abs-phase (- abs-phase mod-phase))) (and used-phase (- used-phase mod-phase)))
ctx id))) ctx id)))
;; free-identifier=?/phases : id phase-level id phase-level -> boolean ;; free-identifier=?/phases : id phase-level id phase-level -> boolean