diff --git a/remix/data0.rkt b/remix/data0.rkt index c155bdc..f6f862e 100644 --- a/remix/data0.rkt +++ b/remix/data0.rkt @@ -14,6 +14,7 @@ syntax/parse racket/generic (prefix-in remix: remix/stx0))) + racket/stxparam racket/unsafe/ops racket/performance-hint (prefix-in remix: remix/stx0)) @@ -441,7 +442,7 @@ #:literals (remix:#%brackets remix:def theory) ;; XXX support parameters [(remix:def (remix:#%brackets theory thy:id) - ;; XXX support properties + ;; XXX support properties (including type) ;; XXX make expandable position v:id ...) (syntax/loc stx @@ -475,6 +476,47 @@ (provide theory model) -;; xxx (dynamic-)interface -;; xxx class -;; xxx data +;; Interfaces & Classes + +(define-syntax interface + (singleton-struct + #:property prop:procedure + (λ (_ stx) + (raise-syntax-error 'interface "Illegal outside def" stx)) + #:methods remix:gen:def-transformer + [(define (def-transform _ stx) + ;; XXX + #'(void))])) + +(define-syntax-parameter clayout + (λ (stx) + (raise-syntax-error 'clayout "Illegal outside class" stx))) +(define-syntax-parameter new + (λ (stx) + (raise-syntax-error 'new "Illegal outside class" stx))) +(define-syntax-parameter this + (λ (stx) + (raise-syntax-error 'this "Illegal outside class" stx))) +(define-syntax-parameter implements + (λ (stx) + (raise-syntax-error 'implements "Illegal outside class" stx))) + +(define-syntax class + (singleton-struct + #:property prop:procedure + (λ (_ stx) + (raise-syntax-error 'class "Illegal outside def" stx)) + #:methods remix:gen:def-transformer + [(define (def-transform _ stx) + ;; XXX + #'(void))])) + +(provide interface + clayout + new + this + implements + (rename-out implements impl) + class) + +;; xxx data (fixed set of interfaces) diff --git a/remix/tests/data-ramble.rkt b/remix/tests/data-ramble.rkt deleted file mode 100644 index 21ae775..0000000 --- a/remix/tests/data-ramble.rkt +++ /dev/null @@ -1,50 +0,0 @@ -;; THEORIES + MODELS - -;; INTERFACES + OBJECTS -;; An interface is just a vtable specification (theory) -;; An implementation is a vtable (model) -;; A class is a set of implementations and a representation -;; +---> (+) private : representation is available -;; +---> ( ) open : no rep, new implementations can be added -;; +---> (-) closed : no rep, no new imps -;; An object is a sealed pair of a class and a layout - -(def [interface 2d<%>] - translate - area) - -(def [class +Circle Circle -Circle] - #:layout circle - #:new (λ (x y r) - ;; this is the layout of the object wrapper - ;; - ;; alternatively, make this something that assumes you want - ;; the below and acts like it. - (this.#:alloc - [rep (circle.#:alloc [c (posn.#:alloc [x x] [y y])] - [r r])]))) - -;; This implementation uses +Circle, so it has access to the -;; representation. -(def [implementation 2d<%> +Circle] - [translate - ;; this is +Circle - (λ (this) - {this.#:set - [c (this.c.#:set [x {x + this.c.x}] - [y {y + this.c.y}])]})] - [area - (λ (this) - {3 * this.r * this.r})]) - -;; Here's a contrived example of using Circle, where you can add -;; things but don't have the representation (i.e. you can implement it -;; based on other things it has) -(def [interface 2dview<%>] - view-area) - -(def [implementation 2dview<%> Circle #:is 2d<%>] - [view-area - ;; this is 2d<%> - (λ (this) (this.area))]) - diff --git a/remix/tests/data-ramble2.rkt b/remix/tests/data-ramble2.rkt deleted file mode 100644 index 937607d..0000000 --- a/remix/tests/data-ramble2.rkt +++ /dev/null @@ -1,37 +0,0 @@ -;; Interfaces & Objects - -(def [interface 2d<%>] - translate - area) - -(def [interface Circle<%>] - (layout-interface circle)) - -(def [class Circle] - #:layout circle - #:new - (λ (x y r) - (this.#:alloc [c (posn.#:alloc [x x] [y y])] - [r r])) - - (layout-implements Circle<%>) - - (def [implements 2d<%>] - [(translate x y) - {this.#:set - [c (this.c.#:set [x {x + this.c.x}] - [y {y + this.c.y}])]}] - [(area) - {3 * this.r * this.r}])) - -(def [Circle C1] (Circle.#:new 1 2 3)) -(module+ test - {C1.Circle<%>.c.x ≡ 1} - {C1.Circle<%>.c.y ≡ 2} - {C1.Circle<%>.r ≡ 3} - {(C1.2d<%>.area) ≡ 27} - (def [Circle C1′] (C1.2d<%>.translate 3 2)) - {C1′.Circle<%>.c.x ≡ 4} - {C1′.Circle<%>.c.y ≡ 4} - {C1′.Circle<%>.r ≡ 3}) - diff --git a/remix/tests/simple.rkt b/remix/tests/simple.rkt index b40cab8..2c77f68 100644 --- a/remix/tests/simple.rkt +++ b/remix/tests/simple.rkt @@ -384,6 +384,7 @@ def x4 {(posn.x p1) ≡ 5} ;; You will also get a copying function (def [posn p2] (p1.#:set [y {p1.y + 2}])) + ;; XXX (def [posn p2] (posn p1 [y {p1.y + 2}])) <---- default use with expr is copy ;; Notice that these built-in functions are keywords, so that they ;; can't conflict with the fields you've defined. {p2.x ≡ 5} @@ -539,6 +540,48 @@ def x4 ;; we can imagine it might be inlinable. {((Monoid-Nat:+.op) 6 Monoid-Nat:+.id) ≡ Monoid-Nat:+.(op Monoid-Nat:+.id 6)}) -;; Interfaces & Class +;; Interfaces & Classes + +(def [interface 2d<%>] + translate + area) + +(def [interface Circle<%>] + ;; xxx make a macro for "interface of layout's fields" + c r) + +(def [class Circle] + (def [clayout] + circle) + (def ([new] x y r) + (this.#:alloc [c (posn.#:alloc [x x] [y y])] + [r r])) + + ;; xxx make a macro from "layout's fields implements this interface" + (def [implements Circle<%>] + [(c) this.c] + [(r) this.r]) + + (def [impl 2d<%>] + [(translate x y) + {this.#:set + [c (this.c.#:set [x {x + this.c.x}] + [y {y + this.c.y}])]}] + [(area) + {3 * this.r * this.r}])) + +;; XXX allow w/o #:new? +;; XXX +#;#; +(def [Circle C1] (Circle.#:new 1 2 3)) +(module+ test + {C1.Circle<%>.c.x ≡ 1} + {C1.Circle<%>.c.y ≡ 2} + {C1.Circle<%>.r ≡ 3} + {(C1.2d<%>.area) ≡ 27} + (def [Circle C1′] (C1.2d<%>.translate 3 2)) + {C1′.Circle<%>.c.x ≡ 4} + {C1′.Circle<%>.c.y ≡ 4} + {C1′.Circle<%>.r ≡ 3}) + -(def [interface ])