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

Combine two let's into a let*', use some #'s.

Browse Source
This commit is contained in:
Eli Barzilay 2011-07-01 15:51:47 -04:00
parent f86687de9c
commit 1276568558
1 changed files with 50 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/racket/contract/private/provide.rkt
View File

@ -6,13 +6,13 @@
(require (for-syntax racket/base (require (for-syntax racket/base
racket/list racket/list
racket/struct-info racket/struct-info
unstable/dirs
(prefix-in a: "helpers.rkt")) (prefix-in a: "helpers.rkt"))
"arrow.rkt" "arrow.rkt"
"base.rkt" "base.rkt"
"guts.rkt" "guts.rkt"
"misc.rkt" "misc.rkt"
"exists.rkt" "exists.rkt"
(for-syntax unstable/dirs)
syntax/location syntax/location
syntax/srcloc) syntax/srcloc)
@ -47,9 +47,9 @@
(λ (stx) (λ (stx)
(if (eq? 'expression (syntax-local-context)) (if (eq? 'expression (syntax-local-context))
;; In an expression context: ;; In an expression context:
(let ([key (syntax-local-lift-context)]) (let* ([key (syntax-local-lift-context)]
;; Already lifted in this lifting context? ;; Already lifted in this lifting context?
(let ([lifted-id [lifted-id
(or (hash-ref saved-id-table key #f) (or (hash-ref saved-id-table key #f)
;; No: lift the contract creation: ;; No: lift the contract creation:
(with-syntax ([contract-id contract-id] (with-syntax ([contract-id contract-id]
@ -60,8 +60,7 @@
(let ([srcloc-code (let ([srcloc-code
(with-syntax (with-syntax
([src ([src
(or (and (or (and (path-string? (syntax-source #'id))
(path-string? (syntax-source #'id))
(path->directory-relative-string (path->directory-relative-string
(syntax-source #'id) #:default #f)) (syntax-source #'id) #:default #f))
(syntax-source #'id))] (syntax-source #'id))]
@ -78,24 +77,22 @@
(quote-module-path) (quote-module-path)
'external-id 'external-id
#,srcloc-code))))))]) #,srcloc-code))))))])
(when key (when key (hash-set! saved-id-table key lifted-id))
(hash-set! saved-id-table key lifted-id))
;; Expand to a use of the lifted expression: ;; Expand to a use of the lifted expression:
(with-syntax ([saved-id (syntax-local-introduce lifted-id)]) (with-syntax ([saved-id (syntax-local-introduce lifted-id)])
(syntax-case stx (set!) (syntax-case stx (set!)
[name [name (identifier? #'name) #'saved-id]
(identifier? (syntax name))
(syntax saved-id)]
[(set! id arg) [(set! id arg)
(raise-syntax-error 'provide/contract (raise-syntax-error
'provide/contract
"cannot set! a provide/contract variable" "cannot set! a provide/contract variable"
stx stx #'id)]
(syntax id))]
[(name . more) [(name . more)
(with-syntax ([app (datum->syntax stx '#%app)]) (with-syntax ([app (datum->syntax stx '#%app)])
(syntax/loc stx (app saved-id . more)))])))) (syntax/loc stx (app saved-id . more)))])))
;; In case of partial expansion for module-level and internal-defn contexts, ;; In case of partial expansion for module-level and internal-defn
;; delay expansion until it's a good time to lift expressions: ;; contexts, delay expansion until it's a good time to lift
;; expressions:
(quasisyntax/loc stx (#%expression #,stx))))))) (quasisyntax/loc stx (#%expression #,stx)))))))
(define-for-syntax (true-provide/contract provide-stx) (define-for-syntax (true-provide/contract provide-stx)