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

With 4f83f7f, the hack around PR7104 is no longer needed.

Browse Source
This commit is contained in:
Eli Barzilay 2011-08-29 16:36:24 -04:00
parent ffbd9e16ea
commit 57ea31cca2
1 changed files with 16 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/ffi/unsafe.rkt
View File

@ -247,31 +247,16 @@
;; The `_fun' macro tears its input apart and reassemble it using pieces from ;; The `_fun' macro tears its input apart and reassemble it using pieces from
;; custom function types (macros). This whole deal needs some work to make ;; custom function types (macros). This whole deal needs some work to make
;; it play nicely with taints and code inspectors, so Matthew wrote the following ;; it play nicely with taints and code inspectors, so Matthew wrote the
;; code. The idea is to create a define-fun-syntax which makes the new ;; following code. The idea is to create a define-fun-syntax which makes the
;; syntax transformer be an object that carries extra information, later used ;; new syntax transformer be an object that carries extra information, later
;; by `expand-fun-syntax/fun'. ;; used by `expand-fun-syntax/fun'.
(define orig-inspector (current-code-inspector)) (define orig-inspector (current-code-inspector))
(define (disarm stx) (define (disarm stx)
(syntax-disarm stx orig-inspector)) (syntax-disarm stx orig-inspector))
;; bug in begin-for-syntax (PR7104), see below
(define foo!!! (make-parameter #f))
(define (expand-fun-syntax/normal fun-stx stx)
((foo!!!) fun-stx stx))
(define-values (make-fun-syntax fun-syntax?
fun-syntax-proc fun-syntax-name)
(let-values ([(desc make pred? get set!)
(make-struct-type
'fun-syntax #f 2 0 #f '() (current-inspector)
expand-fun-syntax/normal)])
(values make pred?
(make-struct-field-accessor get 0 'proc)
(make-struct-field-accessor get 1 'name))))
;; This is used to expand a fun-syntax in a _fun type context. ;; This is used to expand a fun-syntax in a _fun type context.
(define (expand-fun-syntax/fun stx) (define (expand-fun-syntax/fun stx)
(let loop ([stx stx]) (let loop ([stx stx])
@ -370,9 +355,7 @@
;; This is used for a normal expansion of fun-syntax, when not in a _fun type ;; This is used for a normal expansion of fun-syntax, when not in a _fun type
;; context. ;; context.
;; bug in begin-for-syntax (PR7104), see above (define (expand-fun-syntax/normal fun-stx stx)
;; should be (define (expand-fun-syntax/normal fun-stx stx) ...)
(foo!!! (lambda (fun-stx stx)
(define (err msg . sub) (define (err msg . sub)
(apply raise-syntax-error (fun-syntax-name fun-stx) msg stx sub)) (apply raise-syntax-error (fun-syntax-name fun-stx) msg stx sub))
(let ([keys (custom-type->keys stx err)]) (let ([keys (custom-type->keys stx err)])
@ -404,7 +387,17 @@
;; simple type ;; simple type
type)) type))
;; no keys => normal expansion ;; no keys => normal expansion
((fun-syntax-proc fun-stx) stx)))))) ((fun-syntax-proc fun-stx) stx))))
(define-values (make-fun-syntax fun-syntax?
fun-syntax-proc fun-syntax-name)
(let-values ([(desc make pred? get set!)
(make-struct-type
'fun-syntax #f 2 0 #f '() (current-inspector)
expand-fun-syntax/normal)])
(values make pred?
(make-struct-field-accessor get 0 'proc)
(make-struct-field-accessor get 1 'name)))))
;; Use define-fun-syntax instead of define-syntax for forms that ;; Use define-fun-syntax instead of define-syntax for forms that
;; are to be expanded by `_fun': ;; are to be expanded by `_fun':