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:
Jay McCarthy 2015-11-24 20:09:43 -05:00
parent 754bffbe79
commit 8d43fc9770
3 changed files with 64 additions and 11 deletions

View File

@ -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))

View File

@ -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

View File

@ -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})