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

mutation!

Browse Source
This commit is contained in:
Jay McCarthy 2015-12-03 20:03:54 -05:00
parent 79dbc986a3
commit cd1ed0d586
2 changed files with 96 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
remix/data0.rkt
View File

@ -191,23 +191,13 @@
static-interface-members)) static-interface-members))
(begin-for-syntax (begin-for-syntax
;; XXX fill this in for parents, etc
(define-generics layout (define-generics layout
(layout-planner layout) (layout-planner-id layout)
;; xxx the accessors seem to not be around anyways, so instead, ;; xxx the accessors seem to not be around anyways, so instead,
;; this should just be a mapping produced by the planner. ;; this should just be a mapping produced by the planner.
(layout-field->acc layout)) (layout-field->acc layout))
(begin-for-syntax
(define-generics layout-planner (define-generics layout-planner
(layout-planner-mutable? layout-planner))) (layout-planner-mutable? layout-planner))
(define-syntax layout-immutable
(singleton-struct
#:methods gen:layout-planner
[(define (layout-planner-mutable? lp) #f)]))
(define-syntax layout-mutable
(singleton-struct
#:methods gen:layout-planner
[(define (layout-planner-mutable? lp) #t)]))
(define-syntax-class field (define-syntax-class field
#:attributes (name dt) #:attributes (name dt)
@ -217,6 +207,16 @@
(pattern (remix:#%brackets dt name:id) (pattern (remix:#%brackets dt name:id)
#:declare dt (static remix:def-transformer? "def transformer")))) #:declare dt (static remix:def-transformer? "def transformer"))))
(define-syntax layout-immutable
(singleton-struct
#:methods gen:layout-planner
[(define (layout-planner-mutable? lp) #f)]))
(define-syntax layout-mutable
(singleton-struct
#:methods gen:layout-planner
[(define (layout-planner-mutable? lp) #t)]))
(define-syntax phase0:layout (define-syntax phase0:layout
(singleton-struct (singleton-struct
#:property prop:procedure #:property prop:procedure
@ -230,13 +230,28 @@
(~optional (~and (~seq #:parent (~var parent (static layout? "layout"))) (~optional (~and (~seq #:parent (~var parent (static layout? "layout")))
(~bind [parent-va (attribute parent.value)])) (~bind [parent-va (attribute parent.value)]))
#:defaults ([parent-va #f])) #:defaults ([parent-va #f]))
(~optional (~and (~seq #:rep (~var rep (static layout-planner?
"layout planner"))))
#:defaults ([rep #f]))
F:field ...) F:field ...)
(define parent-v (attribute parent-va)) (define parent-v (attribute parent-va))
(define the-planner (define this-rep-id (attribute rep))
(or (and parent-v (layout-planner parent-v)) (define parent-rep-id (and parent-v (layout-planner-id parent-v)))
;; xxx allow the default planner to be customized and (unless (or (not this-rep-id)
;; ensure it is equal to the parent's (not parent-rep-id)
(bound-identifier=? this-rep-id parent-rep-id))
(raise-syntax-error
'layout
(format "Parent (~v) and child (~v) representation planner must match"
parent-rep-id
this-rep-id)
stx))
(define the-planner-id
(or parent-rep-id
this-rep-id
#'layout-immutable)) #'layout-immutable))
(define the-planner
(syntax-local-value the-planner-id))
(define parent-f->acc (define parent-f->acc
(or (and parent-v (layout-field->acc parent-v)) (or (and parent-v (layout-field->acc parent-v))
(hasheq))) (hasheq)))
@ -255,6 +270,7 @@
(hash-set base the-f (vector the-name-f the-dt the-idx)))) (hash-set base the-f (vector the-name-f the-dt the-idx))))
(with-syntax* ([name-alloc (format-id #f "~a-alloc" #'name)] (with-syntax* ([name-alloc (format-id #f "~a-alloc" #'name)]
[name-set (format-id #f "~a-set" #'name)] [name-set (format-id #f "~a-set" #'name)]
[name-set! (format-id #f "~a-set!" #'name)]
[((all-f all-name-f all-f-si-rhs all-f-idx) ...) [((all-f all-name-f all-f-si-rhs all-f-idx) ...)
(for/list ([(the-f v) (in-hash f->acc)]) (for/list ([(the-f v) (in-hash f->acc)])
(match-define (vector the-name-f the-dt the-f-idx) v) (match-define (vector the-name-f the-dt the-f-idx) v)
@ -263,8 +279,22 @@
(list the-name-f '#:is the-dt) (list the-name-f '#:is the-dt)
(list the-name-f)) (list the-name-f))
the-f-idx))] the-f-idx))]
[stx-the-planner the-planner] [stx-the-planner-id the-planner-id]
[stx-f->acc f->acc]) [stx-f->acc f->acc]
[(rep-constructor
rep-accessor rep-mutate
(mutation-interface ...))
;; XXX This should work differently
(if (layout-planner-mutable? the-planner)
(list #'vector
#'unsafe-vector*-ref
#'unsafe-vector*-set!
#'((remix:#%brackets #:set! name-set!)
(remix:#%brackets #:! name-set!)))
(list #'vector-immutable
#'unsafe-vector*-ref
#'void
#'()))])
(syntax/loc stx (syntax/loc stx
(begin (begin
(begin-for-syntax (begin-for-syntax
@ -314,8 +344,7 @@
this-f) this-f)
stx))))]) stx))))])
(syntax/loc stx (syntax/loc stx
;; xxx push this in representation planner (rep-constructor f-val (... ...))))]))
(vector-immutable f-val (... ...))))]))
(define-syntax (name-set stx) (define-syntax (name-set stx)
(syntax-parse stx (syntax-parse stx
[(_ base:expr . args:name-args) [(_ base:expr . args:name-args)
@ -333,37 +362,54 @@
(#,this-name-f base-id)))))]) (#,this-name-f base-id)))))])
(syntax/loc stx (syntax/loc stx
(let ([base-id base]) (let ([base-id base])
;; xxx push this in representation planner (rep-constructor f-val (... ...)))))]))
(vector-immutable f-val (... ...)))))])) (define-syntax (name-set! stx)
(syntax-parse stx
[(_ base:expr . args:name-args)
(with-syntax* ([base-id (generate-temporary #'base)]
[((f-val-id f-val f-idx) (... ...))
(for/list ([(this-f this-f-val)
(in-hash (attribute args.f->rhs))])
(match-define
(vector this-name-f _ this-idx)
(hash-ref f->acc this-f))
(list
(generate-temporary this-f)
this-f-val
this-idx))])
(syntax/loc stx
(let ([f-val-id f-val]
(... ...))
(let ([base-id base])
(rep-mutate base-id f-idx f-val-id)
(... ...)
(void)))))]))
(begin-encourage-inline (begin-encourage-inline
;; xxx push this in representation planner (define (all-name-f v) (rep-accessor v all-f-idx))
(define (all-name-f v) (unsafe-vector*-ref v all-f-idx))
...) ...)
(define-syntax name (define-syntax name
(phase1:static-interface (phase1:static-interface
(remix:#%brackets #:alloc name-alloc) (remix:#%brackets #:alloc name-alloc)
;; xxx perhaps allow planner to not have this
(remix:#%brackets #:set name-set) (remix:#%brackets #:set name-set)
(remix:#%brackets #:= name-set) (remix:#%brackets #:= name-set)
;; xxx add set! if planner says so mutation-interface ...
(remix:#%brackets all-f . all-f-si-rhs) (remix:#%brackets all-f . all-f-si-rhs)
... ...
#:extensions #:extensions
#:methods gen:layout #:methods gen:layout
[(define (layout-planner _) [(define (layout-planner-id _)
#'stx-the-planner) #'stx-the-planner-id)
(define (layout-field->acc _) (define (layout-field->acc _)
f->acc)])))))]))])) f->acc)])))))]))]))
(provide (rename-out [phase0:layout layout]) (provide (rename-out [phase0:layout layout])
(for-meta 2 (for-syntax gen:layout
layout?
gen:layout-planner gen:layout-planner
layout-planner? layout-planner?
layout-planner-mutable?) layout-planner-mutable?)
(for-syntax gen:layout
layout?
layout-immutable layout-immutable
layout-mutable)) layout-mutable)
;; xxx (dynamic-)interface ;; xxx (dynamic-)interface
;; xxx data ;; xxx data

21
remix/tests/simple.rkt
View File

@ -390,11 +390,9 @@
(def [layout weird] (def [layout weird]
[example^ e]) [example^ e])
(module+ test (module+ test
(def [weird w1] (weird.#:alloc [e 1])) (def [weird wr1] (weird.#:alloc [e 1]))
{(w1.e.f 2) ≡ 1} {(wr1.e.f 2) ≡ 1}
{(w1.e.g 2) ≡ 2}) {(wr1.e.g 2) ≡ 2})
;; XXX This is where I am
;; Now, the big reveal, layout has an extensible representation ;; Now, the big reveal, layout has an extensible representation
;; planner system. At the moment, the only representations are ;; planner system. At the moment, the only representations are
@ -424,7 +422,18 @@
;; pointers to the end. ;; pointers to the end.
;; ;;
;; Anyways, here's a mutable example. ;; Anyways, here's a mutable example.
#;
(def [layout world] (def [layout world]
#:rep layout-mutable #:rep layout-mutable
[circle c1] [circle c2]) [circle c1] [circle c2])
(module+ test
(def [world w1] (world.#:alloc [c1 c1] [c2 (c1.#:set [r 3])]))
{w1.c1.r ≡ 8}
{w1.c2.r ≡ 3}
;; The set! is simultaneous
(w1.#:set! [c1 w1.c2] [c2 w1.c1])
{w1.c1.r ≡ 3}
{w1.c2.r ≡ 8}
;; It is aliased to !
(w1.#:! [c1 w1.c2] [c2 w1.c1])
{w1.c1.r ≡ 8}
{w1.c2.r ≡ 3})