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

expandable static interface

Browse Source
This commit is contained in:
Jay McCarthy 2016-02-20 16:47:14 -05:00
parent eb48b06cfc
commit 09419cdb67
1 changed files with 11 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
remix/static-interface0.rkt
View File

@ -36,9 +36,9 @@
(begin-for-syntax (begin-for-syntax
(struct static-interface-data (struct static-interface-data
(si-id members extensions)) (members extensions))
(define (empty-static-interface-data si-id) (define (empty-static-interface-data)
(static-interface-data si-id (make-hasheq) (box null)))) (static-interface-data (make-hasheq) (box null))))
(define-syntax default-si #f) (define-syntax default-si #f)
(define-rename-transformer-parameter current-si (define-rename-transformer-parameter current-si
@ -105,22 +105,21 @@
body-expr ...) body-expr ...)
(syntax/loc stx (syntax/loc stx
(begin (begin
(define-syntax the-sid (empty-static-interface-data #'the-si)) (define-syntax the-sid (empty-static-interface-data))
(splicing-syntax-parameterize (splicing-syntax-parameterize
([current-si ([current-si
(make-rename-transformer #'the-sid)]) (make-rename-transformer #'the-sid)])
body-expr ...) body-expr ...)
(static-interface-after-body the-sid)))]))])) (static-interface-after-body the-si the-sid)))]))]))
(define-syntax (static-interface-after-body stx) (define-syntax (static-interface-after-body stx)
(syntax-parse stx (syntax-parse stx
#:literals () #:literals ()
[(_me the-sid) [(_me int-name the-sid)
#:declare the-sid (static static-interface-data? "static interface data") #:declare the-sid (static static-interface-data? "static interface data")
(match-define (static-interface-data si-id members extensions-b) (match-define (static-interface-data members extensions-b)
(attribute the-sid.value)) (attribute the-sid.value))
(with-syntax* ([int-name si-id] (with-syntax* ([([lhs rhs def-rhs rhs-dt full-def-rhs] ...)
[([lhs rhs def-rhs rhs-dt full-def-rhs] ...)
(for/list ([(lhs rhs*rhs-dt) (in-hash members)]) (for/list ([(lhs rhs*rhs-dt) (in-hash members)])
(match-define (vector rhs rhs-dt) rhs*rhs-dt) (match-define (vector rhs rhs-dt) rhs*rhs-dt)
(define def-rhs (define def-rhs
@ -133,9 +132,9 @@
def-rhs def-rhs
rhs-dt rhs-dt
(if rhs-dt (if rhs-dt
#'(remix:#%brackets rhs-dt def-rhs) #`(remix:#%brackets #,rhs-dt #,def-rhs)
def-rhs)))] def-rhs)))]
[(extension ...) (reverse (unbox extensions-b))]) [((extension ...) ...) (reverse (unbox extensions-b))])
(syntax/loc stx (syntax/loc stx
(remix:def (remix:def
(remix:#%brackets remix:stx int-name) (remix:#%brackets remix:stx int-name)
@ -250,7 +249,7 @@
[(_ . blah) [(_ . blah)
(syntax/loc stx (syntax/loc stx
(real-i . blah))])))))))]))] (real-i . blah))])))))))]))]
extension ...)))))])) extension ... ...)))))]))
(provide static-interface (provide static-interface
static-interface-member static-interface-member