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

class checkpoint

Browse Source
This commit is contained in:
Jay McCarthy 2016-01-18 19:15:07 -05:00
parent 43ca9eba94
commit d08f01c736
3 changed files with 8 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
remix/class0.rkt
View File

@ -106,15 +106,16 @@
([cls cls-id] ([cls cls-id]
[rep rep-id] [rep rep-id]
[cls-vtables (format-id #f "~a-vtables" #'cls)] [cls-vtables (format-id #f "~a-vtables" #'cls)]
[cls-this (format-id #f "~a-this" #'cls)]
[cls-new (format-id #f "~a-new" #'cls)] [cls-new (format-id #f "~a-new" #'cls)]
[cls-Current (format-id #f "~a-Current" #'cls)] [cls-Current (format-id #f "~a-Current" #'cls)]
[cls-alloc* (format-id #f "~a-alloc*" #'cls)] [cls-alloc* (format-id #f "~a-alloc*" #'cls)]
[cls-alloc (format-id #f "~a-alloc" #'cls)] [cls-alloc (format-id #f "~a-alloc" #'cls)]
[((int int-vtable cls-int-impl cls-int-impl-def) ...) [((int int-vtable cls-int-impl cls-int-impl-def) ...)
(for/list ([(int int-internal) (in-dict interface-set)]) (for/list ([(int int-internal) (in-dict interface-set)])
(define cls-int-impl (format-id #f "~a-~a" #'cls int)) (define cls-int-impl-id (format-id #f "~a-~a" #'cls int))
(match-define (list int-vtable-id cls-int-impl-def) (match-define (list int-vtable-id cls-int-impl-def)
(int-internal cls-int-impl)) (int-internal cls-int-impl-id #'cls-this))
(list int int-vtable-id cls-int-impl cls-int-impl-def))] (list int int-vtable-id cls-int-impl cls-int-impl-def))]
[cls-new-def (new-found? #'cls-new)]) [cls-new-def (new-found? #'cls-new)])
(syntax/loc stx (syntax/loc stx
@ -132,7 +133,7 @@
([Current (make-rename-transformer #'cls-Current)]) ([Current (make-rename-transformer #'cls-Current)])
cls-new-def cls-new-def
cls-int-impl-def ... cls-int-impl-def ...
;; XXX bind cls-this (remix:def (remix:#%brackets static-interface cls-this))
(remix:def (remix:#%brackets static-interface cls) (remix:def (remix:#%brackets static-interface cls)
(remix:#%brackets #:new cls-new) (remix:#%brackets #:new cls-new)
(remix:#%brackets int cls-int-impl) (remix:#%brackets int cls-int-impl)
@ -199,7 +200,7 @@
(with-syntax ([int-vtable-id (interface-vtable-id (attribute int.value))] (with-syntax ([int-vtable-id (interface-vtable-id (attribute int.value))]
[int-vtable (interface-vtable (attribute int.value))]) [int-vtable (interface-vtable (attribute int.value))])
(dict-set! is #'int (dict-set! is #'int
(λ (cls-impl-id) (λ (cls-impl-id cls-this-id)
(list (list
#'int-vtable-id #'int-vtable-id
(with-syntax ([cls-impl cls-impl-id]) (with-syntax ([cls-impl cls-impl-id])

2
remix/static-interface0.rkt
View File

@ -202,6 +202,4 @@
static-interface? static-interface?
static-interface-members)) static-interface-members))
;; xxx data (fixed set of interfaces) ;; xxx data (fixed set of interfaces)

12
remix/tests/class.rkt
View File

@ -31,20 +31,16 @@
(impl 2d<%> (impl 2d<%>
[translate [translate
(λ (x y) (λ (x y)
{this.#:set (this.#:set
[c (this.c.#:set [x {x + this.c.x}] [c (this.c.#:set [x {x + this.c.x}]
[y {y + this.c.y}])]})] [y {y + this.c.y}])]))]
[area [area
(λ () {3 * this.r * this.r})])) (λ () {3 * this.r * this.r})]))
;; XXX allow w/o #:new?, like layout ;; XXX allow w/o #:new?, like layout
;; XXX
#;
(def [Circle C1] (Circle.#:new 1 2 3))
;; XXX
#;
(module+ test (module+ test
(def [Circle C1] (Circle.#:new 1 2 3))
;; If you know something is a particular class, then you can access ;; If you know something is a particular class, then you can access
;; its implementations directly. This is more efficient. ;; its implementations directly. This is more efficient.
{C1.Circle<%>.c.x ≡ 1} {C1.Circle<%>.c.x ≡ 1}
@ -64,8 +60,6 @@
{C1-as-Circ.c.y ≡ 2} {C1-as-Circ.c.y ≡ 2}
{C1-as-Circ.r ≡ 3}) {C1-as-Circ.r ≡ 3})
;; XXX
#;
(module+ test (module+ test
;; Like theories, you can define functions that are generic over an ;; Like theories, you can define functions that are generic over an
;; interface. ;; interface.