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

Replace syntax-map with stx-map in plai.

Browse Source
This commit is contained in:
Eric Dobson 2013-05-25 10:28:18 -07:00
parent d6b63dddf7
commit 09ff5cafd4
1 changed files with 32 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
collects/plai/datatype.rkt
View File

@ -55,7 +55,7 @@
(plai-syntax-error 'type-case stx-loc type-case:not-a-type))) (plai-syntax-error 'type-case stx-loc type-case:not-a-type)))
(require (for-syntax syntax/parse (require (for-syntax syntax/parse
racket/syntax unstable/syntax racket/syntax syntax/stx
(only-in racket/function curry))) (only-in racket/function curry)))
(define-for-syntax (syntax-string s) (define-for-syntax (syntax-string s)
@ -106,7 +106,7 @@
;; Ensure variant names are unique. ;; Ensure variant names are unique.
(assert-unique #'(variant ...)) (assert-unique #'(variant ...))
;; Ensure each set of fields have unique names. ;; Ensure each set of fields have unique names.
(syntax-map assert-unique #'((field ...) ...)) (stx-map assert-unique #'((field ...) ...))
;; Ensure type and variant names are unbound ;; Ensure type and variant names are unbound
(map (assert-unbound 'define-type) (map (assert-unbound 'define-type)
@ -119,51 +119,51 @@
(with-syntax (with-syntax
([((field/c-val ...) ...) ([((field/c-val ...) ...)
(syntax-map generate-temporaries #'((field/c ...) ...))] (stx-map generate-temporaries #'((field/c ...) ...))]
[((the-field/c ...) ...) [((the-field/c ...) ...)
(syntax-map generate-temporaries #'((field/c ...) ...))] (stx-map generate-temporaries #'((field/c ...) ...))]
[datatype? [datatype?
(format-id stx "~a?" #'datatype #:source #'datatype)] (format-id stx "~a?" #'datatype #:source #'datatype)]
[(variant? ...) [(variant? ...)
(syntax-map (λ (x) (format-id stx "~a?" x #:source x)) #'(variant ...))] (stx-map (λ (x) (format-id stx "~a?" x #:source x)) #'(variant ...))]
[(variant*? ...) [(variant*? ...)
(syntax-map (λ (x) (format-id x "~a?" x #:source x)) #'(variant* ...))] (stx-map (λ (x) (format-id x "~a?" x #:source x)) #'(variant* ...))]
[(make-variant ...) [(make-variant ...)
(syntax-map (λ (x) (format-id stx "make-~a" x #:source x)) #'(variant ...))] (stx-map (λ (x) (format-id stx "make-~a" x #:source x)) #'(variant ...))]
[(make-variant* ...) [(make-variant* ...)
(syntax-map (λ (x) (format-id x "make-~a" x #:source x)) #'(variant* ...))]) (stx-map (λ (x) (format-id x "make-~a" x #:source x)) #'(variant* ...))])
(with-syntax (with-syntax
([((f:variant? ...) ...) ([((f:variant? ...) ...)
(syntax-map (lambda (v? fs) (stx-map (lambda (v? fs)
(syntax-map (lambda (f) v?) fs)) (stx-map (lambda (f) v?) fs))
#'(variant? ...) #'(variant? ...)
#'((field ...) ...))] #'((field ...) ...))]
[((variant-field ...) ...) [((variant-field ...) ...)
(syntax-map (lambda (variant fields) (stx-map (lambda (variant fields)
(syntax-map (λ (f) (format-id stx "~a-~a" variant f #:source f)) (stx-map (λ (f) (format-id stx "~a-~a" variant f #:source f))
fields)) fields))
#'(variant ...) #'(variant ...)
#'((field ...) ...))] #'((field ...) ...))]
[((variant*-field ...) ...) [((variant*-field ...) ...)
(syntax-map (lambda (variant fields) (stx-map (lambda (variant fields)
(syntax-map (λ (f) (format-id variant "~a-~a" variant f #:source f)) (stx-map (λ (f) (format-id variant "~a-~a" variant f #:source f))
fields)) fields))
#'(variant* ...) #'(variant* ...)
#'((field ...) ...))] #'((field ...) ...))]
[((set-variant-field! ...) ...) [((set-variant-field! ...) ...)
(syntax-map (lambda (variant fields) (stx-map (lambda (variant fields)
(syntax-map (λ (f) (format-id stx "set-~a-~a!" variant f #:source f)) (stx-map (λ (f) (format-id stx "set-~a-~a!" variant f #:source f))
fields)) fields))
#'(variant ...) #'(variant ...)
#'((field ...) ...))] #'((field ...) ...))]
[((set-variant*-field! ...) ...) [((set-variant*-field! ...) ...)
(syntax-map (lambda (variant fields) (stx-map (lambda (variant fields)
(syntax-map (λ (f) (format-id variant "set-~a-~a!" variant f #:source f)) (stx-map (λ (f) (format-id variant "set-~a-~a!" variant f #:source f))
fields)) fields))
#'(variant* ...) #'(variant* ...)
#'((field ...) ...))]) #'((field ...) ...))])
(syntax/loc stx (syntax/loc stx
(begin (begin