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