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

prep for expandable

Browse Source
This commit is contained in:
Jay McCarthy 2016-01-18 19:34:58 -05:00
parent d08f01c736
commit 985b540ccc
3 changed files with 162 additions and 179 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
remix/data0.rkt Normal file
View File

@ -0,0 +1,3 @@
#lang racket/base
;; xxx data (fixed set of interfaces)

51
remix/static-interface0.rkt
View File

@ -31,12 +31,18 @@
(provide interface-member))
(require (submod "." interface-member)
(for-syntax
(submod "." interface-member)))
(submod "." interface-member))))
(define-syntax (phase1:static-interface stx)
(define-syntax static-interface
(singleton-struct
#:property prop:procedure
(λ (_ stx)
(raise-syntax-error 'static-interface "Illegal outside def" stx))
#:methods remix:gen:def-transformer
[(define (def-transform _ stx)
(syntax-parse stx
#:literals (remix:#%brackets)
[(_si
[(_def (remix:#%brackets me:id the-si:id)
;; XXX make expandable position
(remix:#%brackets
lhs:interface-member rhs:id
@ -63,6 +69,8 @@
(list def-rhs '#:is rhs-dt)
(list def-rhs)))])
(syntax/loc stx
(remix:def
(remix:#%brackets remix:stx the-si)
(let ()
(define int-id->orig
(make-immutable-hasheq
@ -138,7 +146,7 @@
[(define (def-transform _ stx)
(syntax-parse stx
#:literals (remix:#%brackets)
[(def (remix:#%brackets me:id i:id) . body)
[(__def (remix:#%brackets me:id i:id) . body)
(with-syntax ([real-i (generate-temporary #'i)])
(syntax/loc stx
(begin
@ -153,8 +161,7 @@
(syntax/loc stx
(rhs real-i . blah))])))
...
(remix:def (remix:#%brackets remix:stx i)
(phase1:static-interface
(remix:def (remix:#%brackets static-interface i)
(remix:#%brackets lhs . full-def-rhs)
...
#:extensions
@ -171,35 +178,11 @@
real-i)]
[(_ . blah)
(syntax/loc stx
(real-i . blah))])))))))]))]
extension ...))))])))
(real-i . blah))]))))))]))]
extension ...)))))]))]))
(define-syntax (define-phase0-def->phase1-macro stx)
(syntax-parse stx
[(_ base:id)
(with-syntax ([phase0:base (format-id #'base "phase0:~a" #'base)]
[phase1:base (format-id #'base "phase1:~a" #'base)])
(syntax/loc stx
(define-syntax phase0:base
(singleton-struct
#:property prop:procedure
(λ (_ stx)
(raise-syntax-error 'base "Illegal outside def" stx))
#:methods remix:gen:def-transformer
[(define (def-transform _ stx)
(syntax-parse stx
#:literals (remix:#%brackets)
[(def (remix:#%brackets me:id i:id) . body)
(syntax/loc stx
(remix:def (remix:#%brackets remix:stx i)
(phase1:base . body)))]))]))))]))
(define-phase0-def->phase1-macro static-interface)
(provide (rename-out [phase0:static-interface static-interface])
(for-syntax (rename-out [phase1:static-interface static-interface])
gen:static-interface
(provide static-interface
(for-syntax gen:static-interface
static-interface?
static-interface-members))
;; xxx data (fixed set of interfaces)

15
remix/tests/static-interface.rkt
View File

@ -10,20 +10,18 @@
;; with particular functions.
(def (example-f x y) x)
(def (example-g x y) y)
(def [stx example^]
(static-interface
(def [static-interface example^]
[f example-f]
[g example-g]))
[g example-g])
(module+ test
{(example^.f 1 2) ≡ 1}
{(example^.g 1 2) ≡ 2})
;; These static interfaces allow nesting
(def example2-h 19)
(def [stx example2^]
(static-interface
(def [static-interface example2^]
[fg example^]
[h example2-h]))
[h example2-h])
(module+ test
{(example2^.fg.f 1 2) ≡ 1}
{(example2^.fg.g 1 2) ≡ 2}
@ -52,11 +50,10 @@
;; 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
(def [static-interface example3^]
;; NB Perhaps it would be more punny to us [def id]?
[fg example2-fg #:is example^]
[h example2-h]))
[h example2-h])
(def example2-fg 1)
(module+ test
{(example3^.fg.f 2) ≡ 1}