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

adding additional layer of static interfaces

Browse Source
This commit is contained in:
Jay McCarthy 2015-11-28 16:07:04 -05:00
parent 124e97acf2
commit f7f1a57334
3 changed files with 74 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
remix/data0.rkt
View File

@ -6,29 +6,35 @@
(prefix-in remix: remix/stx0) (prefix-in remix: remix/stx0)
remix/stx/singleton-struct0 remix/stx/singleton-struct0
(for-syntax racket/base (for-syntax racket/base
syntax/parse)) syntax/parse
(prefix-in remix: remix/stx0)))
(prefix-in remix: remix/stx0)) (prefix-in remix: remix/stx0))
(begin-for-syntax (begin-for-syntax
(define-syntax (static-interface stx) (define-syntax (static-interface stx)
(syntax-parse stx (syntax-parse stx
#:literals (remix:#%brackets) #:literals (remix:#%brackets)
[(_si (remix:#%brackets lhs:id rhs:id) ...) [(_si (remix:#%brackets
lhs:id rhs:id
(~optional
(~seq #:is rhs-dt:id)
#:defaults ([rhs-dt #'#f])))
...)
(with-syntax ([int-name (syntax-local-name)] (with-syntax ([int-name (syntax-local-name)]
[(def-rhs ...) (generate-temporaries #'(rhs ...))]) [(def-rhs ...) (generate-temporaries #'(rhs ...))])
(syntax/loc stx (syntax/loc stx
(let () (let ()
(define int-id->orig-id (define int-id->orig
(make-immutable-hasheq (make-immutable-hasheq
(list (cons 'lhs #'rhs) (list (cons 'lhs (cons #'rhs #'rhs-dt))
...))) ...)))
(define available-ids (define available-ids
(sort (hash-keys int-id->orig-id) (sort (hash-keys int-id->orig)
string<=? string<=?
#:key symbol->string)) #:key symbol->string))
(define (get-binding stx x) (define (get-rhs stx x)
(define xv (syntax->datum x)) (define xv (syntax->datum x))
(hash-ref int-id->orig-id (hash-ref int-id->orig
xv xv
(λ () (λ ()
(raise-syntax-error (raise-syntax-error
@ -38,6 +44,22 @@
available-ids) available-ids)
stx stx
x)))) x))))
(define (get-rhs-id stx x)
(car (get-rhs stx x)))
(define (get-rhs-is stx x)
(define r (cdr (get-rhs stx x)))
(if (syntax-e r)
r
#f))
(define (get-rhs-def stx x-stx)
(define xd (get-rhs-is stx x-stx))
(with-syntax* ([xb (get-rhs-id stx x-stx)]
[x-def
(if xd xd #'remix:stx)]
[x-def-v
(if xd #'xb #'(make-rename-transformer #'xb))])
(quasisyntax/loc stx
(remix:def (remix:#%brackets x-def #,x-stx) x-def-v))))
(singleton-struct (singleton-struct
#:property prop:procedure #:property prop:procedure
(λ (_ stx) (λ (_ stx)
@ -46,36 +68,36 @@
[(define (dot-transform _ stx) [(define (dot-transform _ stx)
(syntax-parse stx (syntax-parse stx
[(_dot me:id x:id) [(_dot me:id x:id)
(get-binding stx #'x)] (get-rhs-id stx #'x)]
[(_dot me:id x:id . more:expr) [(_dot me:id x:id . more:expr)
(with-syntax ([xb (get-binding stx #'x)]) (quasisyntax/loc stx
(syntax/loc stx (remix:block
(let-syntax ([x (make-rename-transformer #'xb)]) #,(get-rhs-def stx #'x)
(remix:#%dot x . more))))]))] (remix:#%dot x . more)))]))]
#:methods remix:gen:app-dot-transformer #:methods remix:gen:app-dot-transformer
[(define (app-dot-transform _ stx) [(define (app-dot-transform _ stx)
(syntax-parse stx (syntax-parse stx
[(_app (_dot me:id x:id) . body:expr) [(_app (_dot me:id x:id) . body:expr)
(quasisyntax/loc stx (quasisyntax/loc stx
(#,(get-binding stx #'x) . body))] (#,(get-rhs-id stx #'x) . body))]
[(_app (_dot me:id x:id . more:expr) . body:expr) [(_app (_dot me:id x:id . more:expr) . body:expr)
(with-syntax ([xb (get-binding stx #'x)]) (quasisyntax/loc stx
(syntax/loc stx (remix:block
(let-syntax ([x (make-rename-transformer #'xb)]) #,(get-rhs-def stx #'x)
(remix:#%app (remix:#%dot x . more) . body))))]))] (remix:#%app (remix:#%dot x . more) . body)))]))]
#:methods remix:gen:def-transformer #:methods remix:gen:def-transformer
[(define (def-transform _ stx) [(define (def-transform _ stx)
(syntax-parse stx (syntax-parse stx
#:literals (remix:#%brackets) #:literals (remix:#%brackets)
[(def (remix:#%brackets me:id x:id) . body:expr) [(def (remix:#%brackets me:id i:id) . body:expr)
(with-syntax ([real-x (generate-temporary #'x)]) (with-syntax ([real-i (generate-temporary #'i)])
(syntax/loc stx (syntax/loc stx
(begin (begin
(remix:def real-x . body) (remix:def real-i . body)
(remix:def (remix:#%brackets remix:mac (def-rhs . blah:expr)) (remix:def (remix:#%brackets remix:mac (def-rhs . blah:expr))
(rhs real-x . blah)) (remix:#%app rhs real-i . blah))
... ...
(remix:def (remix:#%brackets remix:stx x) (remix:def (remix:#%brackets remix:stx i)
(static-interface (static-interface
(remix:#%brackets lhs def-rhs) (remix:#%brackets lhs def-rhs)
...)))))]))]))))]))) ...)))))]))]))))])))

17
remix/stx0.rkt
View File

@ -169,9 +169,10 @@
(define-syntax (#%dot stx) (define-syntax (#%dot stx)
(syntax-parse stx (syntax-parse stx
#:literals (#%dot) #:literals (#%dot)
[(_ x:expr ... (#%dot y:expr ...)) [(_ dt x:expr ... (#%dot y:expr ...))
#:declare dt (static dot-transformer? "dot transformer")
(syntax/loc stx (syntax/loc stx
(#%dot x ... y ...))] (#%dot dt x ... y ...))]
[(_ dt . _) [(_ dt . _)
#:declare dt (static dot-transformer? "dot transformer") #:declare dt (static dot-transformer? "dot transformer")
(dot-transform (attribute dt.value) stx)])) (dot-transform (attribute dt.value) stx)]))
@ -184,7 +185,7 @@
#:literals (#%dot) #:literals (#%dot)
[(_ (~and dot-rator (#%dot x:expr ... (#%dot y:expr ...))) . body:expr) [(_ (~and dot-rator (#%dot x:expr ... (#%dot y:expr ...))) . body:expr)
(syntax/loc stx (syntax/loc stx
(#%app (#%dot x ... y ...) . body))] (remix-#%app (#%dot x ... y ...) . body))]
[(_ (~and dot-rator (#%dot adt . _)) . body:expr) [(_ (~and dot-rator (#%dot adt . _)) . body:expr)
#:declare adt (static app-dot-transformer? "app-dot transformer") #:declare adt (static app-dot-transformer? "app-dot transformer")
(app-dot-transform (attribute adt.value) stx)] (app-dot-transform (attribute adt.value) stx)]
@ -324,7 +325,9 @@
(provide def def* (provide def def*
(for-syntax gen:def-transformer (for-syntax gen:def-transformer
gen:def*-transformer) def-transformer?
gen:def*-transformer
def*-transformer?)
(rename-out [def ≙] ;; \defs (rename-out [def ≙] ;; \defs
[def :=] [def :=]
[def* ≙*] [def* ≙*]
@ -343,9 +346,11 @@
binary-operator? binary-operator?
binary-operator-precedence) binary-operator-precedence)
#%dot #%dot
(for-syntax gen:dot-transformer) (for-syntax gen:dot-transformer
dot-transformer?)
(rename-out [remix-#%app #%app]) (rename-out [remix-#%app #%app])
(for-syntax gen:app-dot-transformer) (for-syntax gen:app-dot-transformer
app-dot-transformer?)
(rename-out [... …]) ;; \ldots (rename-out [... …]) ;; \ldots
#%datum #%datum
quote quote

23
remix/tests/simple.rkt
View File

@ -265,7 +265,9 @@
(module+ test (module+ test
{(example2^.fg.f 1 2) ≡ 1} {(example2^.fg.f 1 2) ≡ 1}
{(example2^.fg.g 1 2) ≡ 2} {(example2^.fg.g 1 2) ≡ 2}
{example2^.h ≡ 19}) {example2^.h ≡ 19}
;; Notice that cut works with nested dots
{(λ.example2^.h 'ignored) ≡ 19})
;; They are also def transformers and when used in that way, they ;; They are also def transformers and when used in that way, they
;; implicitly pass the binding on as the first argument to functions ;; implicitly pass the binding on as the first argument to functions
@ -273,12 +275,25 @@
(def [example^ ee] 1) (def [example^ ee] 1)
(module+ test (module+ test
{(ee.f 2) ≡ 1} {(ee.f 2) ≡ 1}
{(ee.g 2) ≡ 2} {(ee.g 2) ≡ 2})
;; Notice that cut works with nested dots
{(λ.example2^.h 'ignored) ≡ 19})
;; This is especially useful inside of functions ;; This is especially useful inside of functions
(def (f-using-example [example^ ee]) (def (f-using-example [example^ ee])
(ee.f 2)) (ee.f 2))
(module+ test (module+ test
{(f-using-example 1) ≡ 1}) {(f-using-example 1) ≡ 1})
;; Sometimes a static-interface's binding's result is another
;; static-interface, rather than the binding itself. In that case, we
;; use the keyword #:is and specify another def transformer for
;; contexts where the value is in tail position.
(def [stx example3^]
(static-interface
;; NB Perhaps it would be more punny to us [def id]?
[fg example2-fg #:is example^]
[h example2-h]))
(def example2-fg 1)
(module+ test
{(example3^.fg.f 2) ≡ 1}
{(example3^.fg.g 2) ≡ 2}
{example3^.h ≡ 19})