static-interface def transformer
In the process, I had to add dot-app transforming and I found it useful to protected against defining #%brackets (a common error)
This commit is contained in:
parent
754bffbe79
commit
8d43fc9770
|
@ -14,7 +14,8 @@
|
|||
(syntax-parse stx
|
||||
#:literals (remix:#%brackets)
|
||||
[(_si (remix:#%brackets lhs:id rhs:id) ...)
|
||||
(with-syntax ([int-name (syntax-local-name)])
|
||||
(with-syntax ([int-name (syntax-local-name)]
|
||||
[(def-rhs ...) (generate-temporaries #'(rhs ...))])
|
||||
(syntax/loc stx
|
||||
(let ()
|
||||
(define int-id->orig-id
|
||||
|
@ -50,6 +51,33 @@
|
|||
(with-syntax ([xb (get-binding stx #'x)])
|
||||
(syntax/loc stx
|
||||
(let-syntax ([x (make-rename-transformer #'xb)])
|
||||
(remix:#%dot x . more))))]))]))))])))
|
||||
(remix:#%dot x . more))))]))]
|
||||
#:methods remix:gen:app-dot-transformer
|
||||
[(define (app-dot-transform _ stx)
|
||||
(syntax-parse stx
|
||||
[(_app (_dot me:id x:id) . body:expr)
|
||||
(quasisyntax/loc stx
|
||||
(#,(get-binding stx #'x) . body))]
|
||||
[(_app (_dot me:id x:id . more:expr) . body:expr)
|
||||
(with-syntax ([xb (get-binding stx #'x)])
|
||||
(syntax/loc stx
|
||||
(let-syntax ([x (make-rename-transformer #'xb)])
|
||||
(remix:#%app (remix:#%dot x . more) . body))))]))]
|
||||
#:methods remix:gen:def-transformer
|
||||
[(define (def-transform _ stx)
|
||||
(syntax-parse stx
|
||||
#:literals (remix:#%brackets)
|
||||
[(def (remix:#%brackets me:id x:id) . body:expr)
|
||||
(with-syntax ([real-x (generate-temporary #'x)])
|
||||
(syntax/loc stx
|
||||
(begin
|
||||
(remix:def real-x . body)
|
||||
(remix:def (remix:#%brackets remix:mac (def-rhs . blah:expr))
|
||||
(rhs real-x . blah))
|
||||
...
|
||||
(remix:def (remix:#%brackets remix:stx x)
|
||||
(static-interface
|
||||
(remix:#%brackets lhs def-rhs)
|
||||
...)))))]))]))))])))
|
||||
|
||||
(provide (for-syntax static-interface))
|
||||
|
|
|
@ -26,7 +26,7 @@
|
|||
[(_ x:id . body:expr)
|
||||
(syntax/loc stx
|
||||
(define x (remix-block . body)))]
|
||||
[(_ (x . args:expr) . body:expr)
|
||||
[(_ ((~and (~not #%brackets) x) . args:expr) . body:expr)
|
||||
(syntax/loc stx
|
||||
(def x (remix-λ args . body)))]))
|
||||
|
||||
|
@ -43,6 +43,7 @@
|
|||
|
||||
(define-syntax (def*-internal stx)
|
||||
(syntax-parse stx
|
||||
#:literals (#%brackets)
|
||||
;; xxx test this
|
||||
[(_ (#%brackets dt . _) _)
|
||||
#:declare dt (static def*-transformer? "def* transformer")
|
||||
|
@ -52,11 +53,11 @@
|
|||
#:declare dt (static def*-transformer? "def* transformer")
|
||||
(syntax/loc stx
|
||||
(def*-internal ((#%brackets dt) . def-body) bind-body))]
|
||||
[(_ (x:id . def-body:expr) bind-body:expr)
|
||||
[(_ ((~and (~not #%brackets) x:id) . def-body:expr) bind-body:expr)
|
||||
(syntax/loc stx
|
||||
(let ([x (remix-block . def-body)])
|
||||
(remix-block . bind-body)))]
|
||||
[(_ ((x . args:expr) . def-body:expr) bind-body:expr)
|
||||
[(_ (((~and (~not #%brackets) x) . args:expr) . def-body:expr) bind-body:expr)
|
||||
(syntax/loc stx
|
||||
(def*-internal (x (remix-λ args . def-body)) bind-body))]))
|
||||
|
||||
|
@ -72,17 +73,18 @@
|
|||
[(_ . body:expr)
|
||||
(syntax/loc stx
|
||||
(let () . body))]))
|
||||
|
||||
(define-syntax #%brackets
|
||||
(make-rename-transformer #'remix-block))
|
||||
|
||||
(provide def*
|
||||
#%brackets
|
||||
(for-syntax def*-transformer?
|
||||
gen:def*-transformer)
|
||||
remix-block))
|
||||
(require (submod "." remix-block)
|
||||
(for-syntax (submod "." remix-block)))
|
||||
|
||||
(define-syntax #%brackets
|
||||
(make-rename-transformer #'remix-block))
|
||||
|
||||
(begin-for-syntax
|
||||
(define-generics binary-operator
|
||||
(binary-operator-precedence binary-operator))
|
||||
|
@ -170,6 +172,22 @@
|
|||
#:declare dt (static dot-transformer? "dot transformer")
|
||||
(dot-transform (attribute dt.value) stx)]))
|
||||
|
||||
(begin-for-syntax
|
||||
(define-generics app-dot-transformer
|
||||
(app-dot-transform app-dot-transformer stx)))
|
||||
(define-syntax (remix-#%app stx)
|
||||
(syntax-parse stx
|
||||
#:literals (#%dot)
|
||||
[(_ (~and dot-rator (#%dot x:expr ... (#%dot y:expr ...))) . body:expr)
|
||||
(syntax/loc stx
|
||||
(#%app (#%dot x ... y ...) . body))]
|
||||
[(_ (~and dot-rator (#%dot adt . _)) . body:expr)
|
||||
#:declare adt (static app-dot-transformer? "app-dot transformer")
|
||||
(app-dot-transform (attribute adt.value) stx)]
|
||||
[(_ . body:expr)
|
||||
(syntax/loc stx
|
||||
(#%app . body))]))
|
||||
|
||||
(define-syntax (#%rest stx)
|
||||
(raise-syntax-error '#%rest "Illegal outside of function arguments" stx))
|
||||
|
||||
|
@ -301,8 +319,9 @@
|
|||
binary-operator-precedence)
|
||||
#%dot
|
||||
(for-syntax gen:dot-transformer)
|
||||
(rename-out [... …])
|
||||
#%app
|
||||
(rename-out [remix-#%app #%app])
|
||||
(for-syntax gen:app-dot-transformer)
|
||||
(rename-out [... …])
|
||||
#%datum
|
||||
quote
|
||||
unquote
|
||||
|
|
|
@ -245,4 +245,10 @@
|
|||
{(example2^.fg.g 1 2) ≡ 2}
|
||||
{example2^.h ≡ 19})
|
||||
|
||||
|
||||
;; They are also def transformers and when used in that way, they
|
||||
;; implicitly pass the binding on as the first argument to functions
|
||||
;; when used.
|
||||
(def [example^ ee] 1)
|
||||
(module+ test
|
||||
{(ee.f 2) ≡ 1}
|
||||
{(ee.g 2) ≡ 2})
|
||||
|
|
Loading…
Reference in New Issue
Block a user