Working layout

This commit is contained in:
Jay McCarthy 2015-11-30 13:29:38 -05:00
parent b1de40ebfe
commit 10f096b923
2 changed files with 78 additions and 10 deletions

View File

@ -5,6 +5,7 @@
racket/syntax racket/syntax
racket/generic racket/generic
racket/format racket/format
racket/list
(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
@ -42,8 +43,14 @@
(~seq #:extensions (~seq #:extensions
extension ...) extension ...)
#:defaults ([[extension 1] '()]))) #:defaults ([[extension 1] '()])))
(with-syntax ([int-name (syntax-local-name)] (with-syntax* ([int-name (or (syntax-local-name) 'static-interface)]
[(def-rhs ...) (generate-temporaries #'(rhs ...))]) [(def-rhs ...)
(for/list ([lhs (in-list
(map syntax->datum
(syntax->list #'(lhs ...))))])
(format-id #f "~a-~a-for-def" #'int-name
(if (keyword? lhs) (keyword->string lhs)
lhs)))])
(syntax/loc stx (syntax/loc stx
(let () (let ()
(define int-id->orig (define int-id->orig
@ -120,8 +127,15 @@
(syntax/loc stx (syntax/loc stx
(begin (begin
(remix:def real-i . body) (remix:def real-i . body)
(remix:def (remix:#%brackets remix:mac (def-rhs . blah:expr)) (remix:def (remix:#%brackets remix:stx def-rhs)
(remix:#%app rhs real-i . blah)) (λ (stx)
(syntax-parse stx
[_:id
(syntax/loc stx
(rhs real-i))]
[(_ . blah:expr)
(syntax/loc stx
(rhs real-i . blah))])))
... ...
(remix:def (remix:#%brackets remix:stx i) (remix:def (remix:#%brackets remix:stx i)
(phase1:static-interface (phase1:static-interface
@ -179,13 +193,67 @@
[f (in-list (syntax->list #'(f ...)))]) [f (in-list (syntax->list #'(f ...)))])
i)] i)]
[(name-f ...) [(name-f ...)
(generate-temporaries #'(f ...))]) (for/list ([f (in-list (syntax->list #'(f ...)))])
(format-id #f "~a-~a" #'name f))])
(syntax/loc stx (syntax/loc stx
(begin (begin
(begin-for-syntax
(define f->idx*acc
(make-immutable-hasheq
(list (cons 'f (cons f-idx #'name-f))
...)))
(define available-fields
(sort (hash-keys f->idx*acc)
string<=?
#:key symbol->string))
(define-syntax-class name-arg
#:attributes (lhs rhs)
#:literals (remix:#%brackets)
(pattern (remix:#%brackets lhs:id rhs:expr)
#:fail-unless
(hash-has-key? f->idx*acc (syntax->datum #'lhs))
(format "valid field: ~a" available-fields)))
(define-syntax-class name-args
#:attributes (f->rhs)
(pattern (a:name-arg (... ...))
#:do [(define first-dupe
(check-duplicates
(syntax->datum #'(a.lhs (... ...)))))]
#:fail-when first-dupe
(format "field occurs twice: ~a" first-dupe)
#:attr f->rhs
(for/hasheq ([l (syntax->list #'(a.lhs (... ...)))]
[r (syntax->list #'(a.rhs (... ...)))])
(values (syntax->datum l) r)))))
(define-syntax (name-alloc stx) (define-syntax (name-alloc stx)
(raise-syntax-error 'name-alloc "XXX alloc")) (syntax-parse stx
[(_ . args:name-args)
(with-syntax ([(f-val (... ...))
(for/list ([this-f (in-list '(f ...))])
(hash-ref (attribute args.f->rhs)
this-f
(λ ()
(raise-syntax-error
'name-alloc
"missing initializer for ~a"
this-f))))])
(syntax/loc stx
(vector-immutable f-val (... ...))))]))
(define-syntax (name-set stx) (define-syntax (name-set stx)
(raise-syntax-error 'name-set "XXX set")) (syntax-parse stx
[(_ base:expr . args:name-args)
(with-syntax* ([base-id (generate-temporary #'base)]
[(f-val (... ...))
(for/list ([this-f (in-list '(f ...))]
[this-name-f (in-list '(name-f ...))])
(hash-ref (attribute args.f->rhs)
this-f
(λ ()
(quasisyntax/loc stx
(#,this-name-f base-id)))))])
(syntax/loc stx
(let ([base-id base])
(vector-immutable f-val (... ...)))))]))
(begin-encourage-inline (begin-encourage-inline
(define (name-f v) (unsafe-vector*-ref v f-idx)) (define (name-f v) (unsafe-vector*-ref v f-idx))
...) ...)

View File

@ -327,19 +327,19 @@
x y) x y)
(module+ test (module+ test
;; You will get an allocation function named #:alloc ;; You will get an allocation function named #:alloc
(def p1 (posn.#:alloc [x 5] [y 7])) (def [posn p1] (posn.#:alloc [x 5] [y 7]))
;; And accessors ;; And accessors
{p1.x 5} {p1.x 5}
{p1.y 7} {p1.y 7}
;; You will also get a copying function (XXX: Should it be named ;; You will also get a copying function (XXX: Should it be named
;; `copy`? `update`? My analogy here is with hash-set) ;; `copy`? `update`? My analogy here is with hash-set)
(def p2 (p1.#:set [x 8] [y {p1.y + 2}])) (def [posn p2] (p1.#:set [x 8] [y {p1.y + 2}]))
;; Notice that these built-in functions are keywords, so that they ;; Notice that these built-in functions are keywords, so that they
;; can't conflict with the fields you've defined. ;; can't conflict with the fields you've defined.
{p2.x 8} {p2.x 8}
{p2.y 9} {p2.y 9}
;; This is aliased to =, which I expect is nicer to use. ;; This is aliased to =, which I expect is nicer to use.
(def p3 (p1.#:= [x 8] [y {p1.y + 2}])) (def [posn p3] (p1.#:= [x 8] [y {p1.y + 2}]))
{p3.x 8} {p3.x 8}
{p3.y 9}) {p3.y 9})