interface and classes

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)

remix/tests/data-ramble.rkt

@@ -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))])
-

remix/tests/data-ramble2.rkt

@@ -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})
-

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 ])