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

This wasn't used in define/contract either.

Browse Source 
svn: r11646
This commit is contained in:
Stevie Strickland 2008-09-11 16:52:08 +00:00
parent cb07ceefff
commit e5ed38fedc
1 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/scheme/private/contract.ss
View File

@ -50,19 +50,6 @@ improve method arity mismatch contract violation error messages?
; ; ; ;
; ;
;; lookup-struct-info : syntax -> (union #f (list syntax syntax (listof syntax) ...))
(define-for-syntax (lookup-struct-info stx provide-stx)
(let ([id (syntax-case stx ()
[(a b) (syntax a)]
[_ stx])])
(let ([v (syntax-local-value id (λ () #f))])
(if (struct-info? v)
(extract-struct-info v)
(raise-syntax-error 'provide/contract
"expected a struct name"
provide-stx
id)))))
(define-for-syntax (make-define/contract-transformer contract-id id) (define-for-syntax (make-define/contract-transformer contract-id id)
(make-set!-transformer (make-set!-transformer
(λ (stx) (λ (stx)
@ -219,6 +206,19 @@ improve method arity mismatch contract violation error messages?
; ; ; ;
;; lookup-struct-info : syntax -> (union #f (list syntax syntax (listof syntax) ...))
(define-for-syntax (lookup-struct-info stx provide-stx)
(let ([id (syntax-case stx ()
[(a b) (syntax a)]
[_ stx])])
(let ([v (syntax-local-value id (λ () #f))])
(if (struct-info? v)
(extract-struct-info v)
(raise-syntax-error 'provide/contract
"expected a struct name"
provide-stx
id)))))
;; id->contract-src-info : identifier -> syntax ;; id->contract-src-info : identifier -> syntax
;; constructs the last argument to the -contract, given an identifier ;; constructs the last argument to the -contract, given an identifier
(define-for-syntax (id->contract-src-info id) (define-for-syntax (id->contract-src-info id)