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
racket/stxparam
"keywords.rkt"
"runtime.rkt"
(only-in unstable/syntax phase-of-enclosing-module))
"runtime.rkt")
racket/contract/base
"minimatch.rkt"
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)
(define (check-literal-entry stx ctx)
(define (go internal external phase)
(txlift #`(check-literal (quote-syntax #,external)
#,phase
(phase-of-enclosing-module)
(quote-syntax #,ctx)))
(txlift #`(check-literal #,external #,phase #,ctx))
(list internal external phase phase))
(syntax-case stx ()
[(internal external #:phase phase)

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

@ -1,6 +1,7 @@
#lang racket/base
(require racket/list
racket/stxparam
unstable/syntax
"runtime-progress.rkt"
"runtime-failure.rkt"
(for-syntax racket/base
@ -257,15 +258,33 @@
(provide check-literal
free-identifier=?/phases)
;; check-literal : id phase-level phase-level stx -> void
;; FIXME: change to normal 'error', if src gets stripped away
(define (check-literal id abs-phase mod-phase ctx)
(unless (identifier-binding id abs-phase)
;; (check-literal id phase-level-expr ctx) -> void
(define-syntax (check-literal stx)
(syntax-case stx ()
[(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
#f
(format "literal is unbound in phase ~a (phase ~a relative to the enclosing module)"
abs-phase
(and abs-phase (- abs-phase mod-phase)))
used-phase
(and used-phase (- used-phase mod-phase)))
ctx id)))
;; free-identifier=?/phases : id phase-level id phase-level -> boolean