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

Avoid doing require lifting repeatedly

Browse Source 
The redirection for contracted identifiers used to do a
require lift on each use. Instead, only do the lift once
and reuse the identifier.
This commit is contained in:
Asumu Takikawa 2016-06-13 16:05:40 -04:00
parent 78e0100663
commit 67614198c3
1 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
typed-racket-lib/typed-racket/utils/redirect-contract.rkt
View File

@ -1,6 +1,8 @@
#lang racket/base
(require syntax/private/modcollapse-noctc (for-template racket/base))
(require syntax/private/modcollapse-noctc
syntax/id-table
(for-template racket/base))
(provide make-make-redirect-to-contract)
;; This is used to define identifiers that expand to a local-require
@ -24,16 +26,23 @@
;; This code was originally written by mflatt for the plai-typed
;; language, and then slightly adapted for TR by samth.
(define id-table (make-free-id-table))
(define ((make-make-redirect-to-contract contract-defs-submod-modidx) id)
(define (redirect stx)
(cond
[(identifier? stx)
(with-syntax ([mp (collapse-module-path-index
contract-defs-submod-modidx)]
[i (datum->syntax id (syntax-e id) stx stx)])
(syntax-local-lift-require
#`(rename mp i #,(datum->syntax #'mp (syntax-e #'i)))
#'i))]
(cond [(free-id-table-ref id-table stx #f)]
[else
(with-syntax ([mp (collapse-module-path-index
contract-defs-submod-modidx)]
[i (datum->syntax id (syntax-e id) stx stx)])
(define new-id
(syntax-local-lift-require
#`(rename mp i #,(datum->syntax #'mp (syntax-e #'i)))
#'i))
(free-id-table-set! id-table stx new-id)
new-id)])]
[else
(datum->syntax stx
(cons (redirect (car (syntax-e stx)))