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

Refactor to reduce right-ward drift

Browse Source 
original commit: e0cff038c8e086add98f996d343bb49c60c3e3c0
This commit is contained in:
Asumu Takikawa 2013-05-14 14:36:14 -04:00
parent 7afeada73d
commit f865e1501c
1 changed files with 34 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
collects/typed-racket/base-env/prims.rkt
View File

@ -133,38 +133,40 @@ This file defines two sorts of primitives. All of them are provided into any mod
(raise-syntax-error #f "at least one specification is required" stx))
#`(begin c.spec ...)]
[(_ #:internal nm:opt-rename ty lib (~optional [~seq #:struct-maker parent]) ...)
(with-syntax ([cnt* (if (eq? (syntax-local-context) 'top-level)
;; if we're at the top-level, we can generate the contract
;; immediately, but otherwise the contract will be fixed up
;; by the module type-checking pass later
(let ([typ (parse-type #'ty)])
(ignore
(type->contract
typ
;; this is for a `require/typed', so the value is not from the typed side
#:typed-side #f
(lambda ()
(tc-error/stx #'ty "Type ~a could not be converted to a contract." typ)))))
;; in the fix-up case, the contract is just an identifier
;; that is defined below
(generate-temporary #'nm.nm))]
[hidden (generate-temporary #'nm.nm)]
[sm (if (attribute parent)
#'(#:struct-maker parent)
#'())])
(let ([prop-name (if (attribute parent)
'typechecker:contract-def/maker
'typechecker:contract-def)])
(quasisyntax/loc stx
(begin
;; define `cnt*` to be fixed up later by the module
;; type-checking (not defined at top-level since it
;; doesn't work with local expansion)
#,@(ignore (if (eq? (syntax-local-context) 'top-level)
#'()
#`(#,(syntax-property #'(define cnt* #f) prop-name #'ty))))
#,(internal #'(require/typed-internal hidden ty . sm))
#,(ignore #'(require/contract nm.spec hidden cnt* lib))))))]))
(define/with-syntax cnt*
(if (eq? (syntax-local-context) 'top-level)
;; if we're at the top-level, we can generate the contract
;; immediately, but otherwise the contract will be fixed up
;; by the module type-checking pass later
(let ([typ (parse-type #'ty)])
(ignore
(type->contract
typ
;; this is for a `require/typed', so the value is not
;; from the typed side
#:typed-side #f
(lambda ()
(tc-error/stx #'ty "Type ~a could not be converted to a contract." typ)))))
;; in the fix-up case, the contract is just an identifier
;; that is defined below
(generate-temporary #'nm.nm)))
(define/with-syntax hidden (generate-temporary #'nm.nm))
(define/with-syntax sm (if (attribute parent)
#'(#:struct-maker parent)
#'()))
(define prop-name (if (attribute parent)
'typechecker:contract-def/maker
'typechecker:contract-def))
(quasisyntax/loc stx
(begin
;; define `cnt*` to be fixed up later by the module
;; type-checking (not defined at top-level since it
;; doesn't work with local expansion)
#,@(ignore (if (eq? (syntax-local-context) 'top-level)
#'()
#`(#,(syntax-property #'(define cnt* #f) prop-name #'ty))))
#,(internal #'(require/typed-internal hidden ty . sm))
#,(ignore #'(require/contract nm.spec hidden cnt* lib))))]))
(values (r/t-maker #t) (r/t-maker #f))))
(define-syntax-rule (require/typed/provide lib [nm t] ...)