Last active
November 11, 2022 03:25
-
-
Save samdphillips/2ceb10fbe05e18c0c7cb00d920b48a5d to your computer and use it in GitHub Desktop.
Rhombus with class
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #lang rhombus | |
| import: | |
| racket/base | |
| racket/math: | |
| expose: | |
| pi | |
| operator (m ** n): | |
| ~stronger_than: * | |
| base.expt(m, n) | |
| // interfaces are similar to field-less classes and not method signatures like Java | |
| interface Shape: | |
| unimplemented area | |
| unimplemented perimeter | |
| class Circle(radius :: Number): | |
| implements Shape | |
| override method area() :: Number: | |
| pi * this.radius ** 2 | |
| override method perimeter() :: Number: | |
| 2 * pi * this.radius | |
| class Rectangle(w :: Number, h :: Number): | |
| nonfinal | |
| implements Shape | |
| override method area() :: Number: | |
| w * h | |
| override method perimeter() :: Number: | |
| 2 * (w + h) | |
| class Square(): | |
| extends Rectangle | |
| constructor (make): | |
| // NB: `make` is (in this case) (Number * Number) -> () -> Square | |
| fun (side :: Number): | |
| make(side, side)() | |
| use_static | |
| val c :: Circle: Circle(5) | |
| c | |
| c.area() | |
| c.perimeter() | |
| val r :: Rectangle: Rectangle(3, 4) | |
| r | |
| r.area() | |
| r.perimeter() | |
| val s :: Square: Square(10) | |
| s | |
| s.area() | |
| s.perimeter() | |
| val shapes: [c, r, s] | |
| base.map(fun (s :: Shape): s.area(), shapes) | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| (module shapes rhombus | |
| (#%module-begin | |
| (module configure-runtime racket/base | |
| (#%module-begin (module configure-runtime '#%kernel | |
| (#%module-begin (#%require racket/runtime-config) (#%app configure '#f))) | |
| (#%require rhombus/runtime-config))) | |
| (#%declare #:realm rhombus #:require=define) | |
| (#%require (for-meta 0 racket/base) | |
| (for-meta 0 | |
| (portal base | |
| ((import racket/base | |
| racket/base | |
| mod-ctx) | |
| base | |
| base))) | |
| (for-meta 1 | |
| (portal base | |
| ((import racket/base | |
| racket/base | |
| mod-ctx) | |
| base | |
| base)))) | |
| (#%require (for-meta 0 | |
| racket/math | |
| (rename racket/math | |
| pi | |
| pi)) | |
| (for-meta 0 | |
| (portal math | |
| ((import racket/math | |
| (expose-in racket/math pi) | |
| mod-ctx) | |
| math | |
| math)))) | |
| (define-values (**1) | |
| (lambda (m2 n3) | |
| (let-values ([(m2) m2]) | |
| (if '#t | |
| (let-values () | |
| (let-values ([(m) m2]) | |
| (let-values ([(n3) n3]) | |
| (if '#t | |
| (let-values () | |
| (let-values ([(n) n3]) (let-values () (let-values () (#%app expt m n))))) | |
| (let-values () (#%app argument-binding-failure '** n3 '"Any")))))) | |
| (let-values () (#%app argument-binding-failure '** m2 '"Any")))))) | |
| (define-syntaxes (**) | |
| (#%app | |
| expression-infix-operator34 | |
| (quote-syntax **) | |
| (#%app list (#%app cons (quote-syntax *) 'stronger)) | |
| 'automatic | |
| (lambda (left right self-stx) | |
| (#%app | |
| relocate | |
| (#%app span-srcloc left right) | |
| (#%app | |
| wrap-static-info* | |
| (let-values ([(ws1) (#%app datum->syntax (quote-syntax here) left)] | |
| [(ws2) (#%app datum->syntax (quote-syntax here) right)]) | |
| (let-values ([(arg) ws1]) | |
| (let-values ([(rslt) arg]) | |
| (if '#t | |
| (let-values ([(sc3) rslt]) | |
| (let-values () | |
| (let-values ([(arg) ws2]) | |
| (let-values ([(rslt) arg]) | |
| (if '#t | |
| (let-values ([(sc4) rslt]) | |
| (let-values () | |
| (#%app t-subst '#f (quote-syntax (**1 _ _)) '(1 2) sc3 sc4))) | |
| (let-values ([(rslt) (#%app (lambda (e) null) arg)]) | |
| (if rslt | |
| (let-values () | |
| (let-values () (#%app with-syntax-fail (quote-syntax uq1)))) | |
| (#%app raise-syntax-error '#f '"bad syntax" arg)))))))) | |
| (let-values ([(rslt) (#%app (lambda (e) null) arg)]) | |
| (if rslt | |
| (let-values () (let-values () (#%app with-syntax-fail (quote-syntax uq2)))) | |
| (#%app raise-syntax-error '#f '"bad syntax" arg))))))) | |
| (quote-syntax ())))) | |
| 'left)) | |
| (define-values () (let-values () (let-values () (#%app values)))) | |
| (define-values (prop:Shape Shape? Shape-ref) (#%app make-struct-type-property 'Shape)) | |
| (define-syntaxes (Shape) | |
| (#%app identifier-annotation | |
| (quote-syntax Shape) | |
| (quote-syntax Shape?) | |
| (quote-syntax ((#%dot-provider Shape-instance))))) | |
| (define-values (area6) (#%app make-method-accessor 'area Shape-ref '0)) | |
| (define-syntaxes (area7) | |
| (#%app make-method-accessor-transformer | |
| (quote-syntax area7) | |
| (quote-syntax Shape-ref) | |
| '0 | |
| (quote-syntax area6))) | |
| (define-values (perimeter4) (#%app make-method-accessor 'perimeter Shape-ref '1)) | |
| (define-syntaxes (perimeter5) | |
| (#%app make-method-accessor-transformer | |
| (quote-syntax perimeter5) | |
| (quote-syntax Shape-ref) | |
| '1 | |
| (quote-syntax perimeter4))) | |
| (#%require (portal Shape (map Shape (area area7) (perimeter perimeter5)))) | |
| (define-syntaxes (Shape-instance) | |
| (#%app dot-provider-more-static34 (#%app make-handle-class-instance-dot (quote-syntax Shape)))) | |
| (define-syntaxes (Shape) | |
| (#%app interface-desc1 | |
| (quote-syntax Shape) | |
| '#f | |
| (quote-syntax ()) | |
| (quote-syntax prop:Shape) | |
| (quote-syntax Shape-ref) | |
| '#(#& area #& perimeter) | |
| (quote-syntax #(#:unimplemented #:unimplemented)) | |
| '#hasheq((area . #& 0) (perimeter . #& 1)))) | |
| (define-values (area9 perimeter10) | |
| (let-values () | |
| (let-values () | |
| (#%app | |
| values | |
| (let-values | |
| ([(area) (begin | |
| (quote-syntax (#%function-arity (2 () ()))) | |
| (lambda (this-obj) | |
| (let-values () | |
| (let-values () | |
| (if (#%app Circle? this-obj) | |
| (#%app void) | |
| (let-values () (#%app raise-not-an-instance 'Circle this-obj))) | |
| (let-values () | |
| (let-values () | |
| (let-values ([(result) (let-values () | |
| (#%app * | |
| pi | |
| (#%app **1 | |
| (#%app Circle.radius | |
| (begin | |
| (quote-syntax | |
| (#%dot-provider | |
| Circle.instance)) | |
| this-obj)) | |
| '2)))]) | |
| (if (#%app number? result) | |
| result | |
| (#%app result-failure 'area result)))))))))]) | |
| area) | |
| (let-values ([(perimeter) | |
| (begin | |
| (quote-syntax (#%function-arity (2 () ()))) | |
| (lambda (this-obj) | |
| (let-values () | |
| (let-values () | |
| (if (#%app Circle? this-obj) | |
| (#%app void) | |
| (let-values () (#%app raise-not-an-instance 'Circle this-obj))) | |
| (let-values () | |
| (let-values () | |
| (let-values ([(result) (let-values () | |
| (#%app * | |
| (#%app * '2 pi) | |
| (#%app Circle.radius | |
| (begin | |
| (quote-syntax | |
| (#%dot-provider | |
| Circle.instance)) | |
| this-obj))))]) | |
| (if (#%app number? result) | |
| result | |
| (#%app result-failure 'perimeter result)))))))))]) | |
| perimeter))))) | |
| (define-values (class:Circle make-Circle Circle? Circle.radius) | |
| (let-values ([(class:Circle Circle Circle? Circle-ref name-set!) | |
| (#%app make-struct-type | |
| 'Circle | |
| '#f | |
| '1 | |
| '0 | |
| '#f | |
| (#%app list | |
| (#%app cons | |
| prop:field-name->accessor | |
| (#%app list* | |
| '(radius) | |
| (#%app hasheq) | |
| (#%app hasheq 'area area9 'perimeter perimeter10))) | |
| (#%app cons prop:sealed '#t) | |
| (#%app cons prop:methods (#%app vector area9 perimeter10)) | |
| (#%app cons prop:Shape (#%app vector area9 perimeter10))) | |
| '#f | |
| '#f | |
| '(0) | |
| (lambda (radius who) | |
| (#%app values | |
| (if (#%app number? radius) | |
| radius | |
| (#%app raise-annotation-failure who radius '"Number")))))]) | |
| (#%app values | |
| class:Circle | |
| Circle | |
| Circle? | |
| (#%app make-struct-field-accessor Circle-ref '0 'Circle.radius 'Circle 'rhombus)))) | |
| (define-values (Circle-ref) | |
| (lambda (v) | |
| (if (#%app Circle? v) (#%app prop-methods-ref v) (#%app raise-not-an-instance 'Circle v)))) | |
| (define-syntaxes (Circle) | |
| (#%app binding-transformer | |
| (quote-syntax Circle) | |
| (let-values ([(...te/class-binding.rkt:44:21) make-composite-binding-transformer] | |
| [(temp3) '"Circle"] | |
| [(temp4) (quote-syntax Circle?)] | |
| [(temp5) (quote-syntax ((#%dot-provider Circle.instance)))] | |
| [(temp6) (#%app list (quote-syntax Circle.radius))] | |
| [(temp7) '(#f)] | |
| [(temp8) (#%app list (quote-syntax ()))] | |
| [(temp9) '#t]) | |
| (#%app (#%app checked-procedure-check-and-extract | |
| struct:keyword-procedure | |
| ...te/class-binding.rkt:44:21 | |
| keyword-procedure-extract | |
| '(#:accessor->info? #:keywords #:static-infos) | |
| '6) | |
| '(#:accessor->info? #:keywords #:static-infos) | |
| (#%app list temp9 temp7 temp5) | |
| temp3 | |
| temp4 | |
| temp6 | |
| temp8)))) | |
| (begin-for-syntax | |
| (define-values (root-proc of-proc) | |
| (let-values ([(accessors) (#%app list (quote-syntax Circle.radius))]) | |
| (#%app annotation-constructor | |
| (t-quote-syntax Circle) | |
| (quote-syntax Circle?) | |
| (quote-syntax ((#%dot-provider Circle.instance))) | |
| '1 | |
| '(#f) | |
| (#%app make-class-instance-predicate accessors) | |
| (#%app make-class-instance-static-infos accessors) | |
| parse-annotation-of)))) | |
| (define-syntaxes (Circle11) root-proc) | |
| (#%require (portal Circle (map Circle (of of) (#f Circle11)))) | |
| (define-syntaxes (of) of-proc) | |
| (define-syntaxes (Circle12) | |
| (#%app class-expression-transformer (quote-syntax Circle) (quote-syntax make-Circle))) | |
| (#%require | |
| (portal Circle | |
| (map Circle (radius Circle.radius) (area area9) (perimeter perimeter10) (#f Circle12)))) | |
| (define-syntaxes (Circle.instance) | |
| (#%app dot-provider-more-static34 (#%app make-handle-class-instance-dot (quote-syntax Circle)))) | |
| (define-syntaxes (make-Circle) | |
| (#%app static-info12 | |
| (#%app list (t-quote-syntax (#%call-result ((#%dot-provider Circle.instance))))))) | |
| (define-syntaxes (Circle.radius) | |
| (#%app static-info12 (#%app list (t-quote-syntax (#%call-result ()))))) | |
| (define-syntaxes (Circle) | |
| (#%app class-desc1 | |
| '#t | |
| (quote-syntax Circle) | |
| '#f | |
| (quote-syntax class:Circle) | |
| (quote-syntax Circle-ref) | |
| (#%app list | |
| (#%app list | |
| 'radius | |
| (quote-syntax Circle.radius) | |
| (quote-syntax #f) | |
| (quote-syntax ()) | |
| (quote-syntax #f))) | |
| '#f | |
| '#(#& area #& perimeter) | |
| (quote-syntax #(area9 perimeter10)) | |
| '#hasheq((area . #& 0) (perimeter . #& 1)) | |
| '#f | |
| '#f | |
| '#f | |
| '#f)) | |
| (define-values (area13 perimeter14) | |
| (let-values () | |
| (let-values () | |
| (#%app | |
| values | |
| (let-values ([(area) | |
| (begin | |
| (quote-syntax (#%function-arity (2 () ()))) | |
| (lambda (this-obj) | |
| (let-values () | |
| (let-values () | |
| (if (#%app Rectangle? this-obj) | |
| (#%app void) | |
| (let-values () (#%app raise-not-an-instance 'Rectangle this-obj))) | |
| (let-values () | |
| (let-values () | |
| (let-values ([(result) (let-values () | |
| (#%app * | |
| (#%app Rectangle.w this-obj) | |
| (#%app Rectangle.h this-obj)))]) | |
| (if (#%app number? result) | |
| result | |
| (#%app result-failure 'area result)))))))))]) | |
| area) | |
| (let-values ([(perimeter) | |
| (begin | |
| (quote-syntax (#%function-arity (2 () ()))) | |
| (lambda (this-obj) | |
| (let-values () | |
| (let-values () | |
| (if (#%app Rectangle? this-obj) | |
| (#%app void) | |
| (let-values () (#%app raise-not-an-instance 'Rectangle this-obj))) | |
| (let-values () | |
| (let-values () | |
| (let-values ([(result) | |
| (let-values () | |
| (#%app * | |
| '2 | |
| (#%app + | |
| (#%app Rectangle.w this-obj) | |
| (#%app Rectangle.h this-obj))))]) | |
| (if (#%app number? result) | |
| result | |
| (#%app result-failure 'perimeter result)))))))))]) | |
| perimeter))))) | |
| (define-values (class:Rectangle make-Rectangle Rectangle? Rectangle.w Rectangle.h) | |
| (let-values | |
| ([(class:Rectangle Rectangle Rectangle? Rectangle-ref name-set!) | |
| (#%app | |
| make-struct-type | |
| 'Rectangle | |
| '#f | |
| '2 | |
| '0 | |
| '#f | |
| (#%app | |
| list | |
| (#%app | |
| cons | |
| prop:field-name->accessor | |
| (#%app list* '(w h) (#%app hasheq) (#%app hasheq 'area area13 'perimeter perimeter14))) | |
| (#%app cons prop:methods (#%app vector area13 perimeter14)) | |
| (#%app cons prop:Shape (#%app vector area13 perimeter14))) | |
| '#f | |
| '#f | |
| '(0 1) | |
| (lambda (w h who) | |
| (#%app values | |
| (if (#%app number? w) w (#%app raise-annotation-failure who w '"Number")) | |
| (if (#%app number? h) h (#%app raise-annotation-failure who h '"Number")))))]) | |
| (#%app values | |
| class:Rectangle | |
| Rectangle | |
| Rectangle? | |
| (#%app make-struct-field-accessor Rectangle-ref '0 'Rectangle.w 'Rectangle 'rhombus) | |
| (#%app make-struct-field-accessor Rectangle-ref '1 'Rectangle.h 'Rectangle 'rhombus)))) | |
| (define-values (Rectangle-ref) | |
| (lambda (v) | |
| (if (#%app Rectangle? v) | |
| (#%app prop-methods-ref v) | |
| (#%app raise-not-an-instance 'Rectangle v)))) | |
| (define-syntaxes (Rectangle) | |
| (#%app binding-transformer | |
| (quote-syntax Rectangle) | |
| (let-values ([(...te/class-binding.rkt:44:21) make-composite-binding-transformer] | |
| [(temp10) '"Rectangle"] | |
| [(temp11) (quote-syntax Rectangle?)] | |
| [(temp12) (quote-syntax ((#%dot-provider Rectangle.instance)))] | |
| [(temp13) (#%app list (quote-syntax Rectangle.w) (quote-syntax Rectangle.h))] | |
| [(temp14) '(#f #f)] | |
| [(temp15) (#%app list (quote-syntax ()) (quote-syntax ()))] | |
| [(temp16) '#t]) | |
| (#%app (#%app checked-procedure-check-and-extract | |
| struct:keyword-procedure | |
| ...te/class-binding.rkt:44:21 | |
| keyword-procedure-extract | |
| '(#:accessor->info? #:keywords #:static-infos) | |
| '6) | |
| '(#:accessor->info? #:keywords #:static-infos) | |
| (#%app list temp16 temp14 temp12) | |
| temp10 | |
| temp11 | |
| temp13 | |
| temp15)))) | |
| (begin-for-syntax | |
| (define-values (root-proc of-proc) | |
| (let-values ([(accessors) (#%app list (quote-syntax Rectangle.w) (quote-syntax Rectangle.h))]) | |
| (#%app annotation-constructor | |
| (t-quote-syntax Rectangle) | |
| (quote-syntax Rectangle?) | |
| (quote-syntax ((#%dot-provider Rectangle.instance))) | |
| '2 | |
| '(#f #f) | |
| (#%app make-class-instance-predicate accessors) | |
| (#%app make-class-instance-static-infos accessors) | |
| parse-annotation-of)))) | |
| (define-syntaxes (Rectangle19) root-proc) | |
| (#%require (portal Rectangle (map Rectangle (of of) (#f Rectangle19)))) | |
| (define-syntaxes (of) of-proc) | |
| (define-values (area17) (#%app make-method-accessor 'area Rectangle-ref '0)) | |
| (define-syntaxes (area18) | |
| (#%app make-method-accessor-transformer | |
| (quote-syntax area18) | |
| (quote-syntax Rectangle-ref) | |
| '0 | |
| (quote-syntax area17))) | |
| (define-values (perimeter15) (#%app make-method-accessor 'perimeter Rectangle-ref '1)) | |
| (define-syntaxes (perimeter16) | |
| (#%app make-method-accessor-transformer | |
| (quote-syntax perimeter16) | |
| (quote-syntax Rectangle-ref) | |
| '1 | |
| (quote-syntax perimeter15))) | |
| (define-syntaxes (Rectangle20) | |
| (#%app class-expression-transformer (quote-syntax Rectangle) (quote-syntax make-Rectangle))) | |
| (#%require (portal Rectangle | |
| (map Rectangle | |
| (w Rectangle.w) | |
| (h Rectangle.h) | |
| (area area18) | |
| (perimeter perimeter16) | |
| (#f Rectangle20)))) | |
| (define-syntaxes (Rectangle.instance) | |
| (#%app dot-provider-more-static34 | |
| (#%app make-handle-class-instance-dot (quote-syntax Rectangle)))) | |
| (define-syntaxes (make-Rectangle) | |
| (#%app static-info12 | |
| (#%app list (t-quote-syntax (#%call-result ((#%dot-provider Rectangle.instance))))))) | |
| (define-syntaxes (Rectangle.w) | |
| (#%app static-info12 (#%app list (t-quote-syntax (#%call-result ()))))) | |
| (define-syntaxes (Rectangle.h) | |
| (#%app static-info12 (#%app list (t-quote-syntax (#%call-result ()))))) | |
| (define-syntaxes (Rectangle) | |
| (#%app class-desc1 | |
| '#f | |
| (quote-syntax Rectangle) | |
| '#f | |
| (quote-syntax class:Rectangle) | |
| (quote-syntax Rectangle-ref) | |
| (#%app list | |
| (#%app list | |
| 'w | |
| (quote-syntax Rectangle.w) | |
| (quote-syntax #f) | |
| (quote-syntax ()) | |
| (quote-syntax #f)) | |
| (#%app list | |
| 'h | |
| (quote-syntax Rectangle.h) | |
| (quote-syntax #f) | |
| (quote-syntax ()) | |
| (quote-syntax #f))) | |
| '#f | |
| '#(#& area #& perimeter) | |
| (quote-syntax #(area13 perimeter14)) | |
| '#hasheq((area . #& 0) (perimeter . #& 1)) | |
| '#f | |
| '#f | |
| '#f | |
| '#f)) | |
| (define-values () (let-values () (let-values () (#%app values)))) | |
| (define-values (class:Square make-Square Square?) | |
| (let-values ([(class:Square Square Square? Square-ref name-set!) | |
| (#%app make-struct-type | |
| 'Square | |
| class:Rectangle | |
| '0 | |
| '0 | |
| '#f | |
| (#%app list | |
| (#%app cons | |
| prop:field-name->accessor | |
| (#%app list* | |
| '() | |
| (#%app hasheq 'w Rectangle.w 'h Rectangle.h) | |
| (#%app hasheq 'area area13 'perimeter perimeter14))) | |
| (#%app cons prop:methods (#%app vector area13 perimeter14))) | |
| '#f | |
| '#f | |
| '() | |
| '#f)]) | |
| (#%app values class:Square Square Square?))) | |
| (define-values (Square-ref) | |
| (lambda (v) | |
| (if (#%app Square? v) (#%app prop-methods-ref v) (#%app raise-not-an-instance 'Square v)))) | |
| (define-values (Square-maker) | |
| (lambda (make) | |
| (let-values | |
| ([(Square) | |
| (begin | |
| (quote-syntax (#%function-arity (1 () ()))) | |
| (lambda (side38) | |
| (let-values | |
| ([(r) (let-values ([(side38) side38]) | |
| (if (#%app number? side38) | |
| (let-values () | |
| (if '#t | |
| (let-values () | |
| (let-values ([(side) side38]) | |
| (let-values () | |
| (let-values () (#%app (#%app make side side)))))) | |
| (let-values () | |
| (#%app argument-binding-failure 'Square side38 '"Number")))) | |
| (let-values () | |
| (#%app argument-binding-failure 'Square side38 '"Number"))))]) | |
| (if (#%app Square? r) r (#%app raise-constructor-result-error 'Square r)))))]) | |
| Square))) | |
| (define-values (Square-ctr) | |
| (#%app Square-maker (lambda (temp21 temp22) (lambda () (#%app make-Square temp21 temp22))))) | |
| (define-syntaxes (Square) | |
| (#%app binding-transformer | |
| (quote-syntax Square) | |
| (let-values ([(...te/class-binding.rkt:44:21) make-composite-binding-transformer] | |
| [(temp17) '"Square"] | |
| [(temp18) (quote-syntax Square?)] | |
| [(temp19) (quote-syntax ((#%dot-provider Square.instance)))] | |
| [(temp20) (#%app list (quote-syntax Rectangle.w) (quote-syntax Rectangle.h))] | |
| [(temp21) '(#f #f)] | |
| [(temp22) (#%app list (quote-syntax ()) (quote-syntax ()))] | |
| [(temp23) '#t]) | |
| (#%app (#%app checked-procedure-check-and-extract | |
| struct:keyword-procedure | |
| ...te/class-binding.rkt:44:21 | |
| keyword-procedure-extract | |
| '(#:accessor->info? #:keywords #:static-infos) | |
| '6) | |
| '(#:accessor->info? #:keywords #:static-infos) | |
| (#%app list temp23 temp21 temp19) | |
| temp17 | |
| temp18 | |
| temp20 | |
| temp22)))) | |
| (begin-for-syntax | |
| (define-values (root-proc of-proc) | |
| (let-values ([(accessors) (#%app list (quote-syntax Rectangle.w) (quote-syntax Rectangle.h))]) | |
| (#%app annotation-constructor | |
| (t-quote-syntax Square) | |
| (quote-syntax Square?) | |
| (quote-syntax ((#%dot-provider Square.instance))) | |
| '2 | |
| '(#f #f) | |
| (#%app make-class-instance-predicate accessors) | |
| (#%app make-class-instance-static-infos accessors) | |
| parse-annotation-of)))) | |
| (define-syntaxes (Square27) root-proc) | |
| (#%require (portal Square (map Square (of of) (#f Square27)))) | |
| (define-syntaxes (of) of-proc) | |
| (define-values (area25) (#%app make-method-accessor 'area Square-ref '0)) | |
| (define-syntaxes (area26) | |
| (#%app make-method-accessor-transformer | |
| (quote-syntax area26) | |
| (quote-syntax Square-ref) | |
| '0 | |
| (quote-syntax area25))) | |
| (define-values (perimeter23) (#%app make-method-accessor 'perimeter Square-ref '1)) | |
| (define-syntaxes (perimeter24) | |
| (#%app make-method-accessor-transformer | |
| (quote-syntax perimeter24) | |
| (quote-syntax Square-ref) | |
| '1 | |
| (quote-syntax perimeter23))) | |
| (define-syntaxes (Square28) | |
| (#%app class-expression-transformer (quote-syntax Square) (quote-syntax Square-ctr))) | |
| (#%require (portal Square (map Square (area area26) (perimeter perimeter24) (#f Square28)))) | |
| (define-syntaxes (Square.instance) | |
| (#%app dot-provider-more-static34 (#%app make-handle-class-instance-dot (quote-syntax Square)))) | |
| (define-syntaxes (Square-ctr) | |
| (#%app static-info12 | |
| (#%app list (t-quote-syntax (#%call-result ((#%dot-provider Square.instance))))))) | |
| (define-syntaxes (Square) | |
| (#%app class-desc1 | |
| '#f | |
| (quote-syntax Square) | |
| (quote-syntax Rectangle) | |
| (quote-syntax class:Square) | |
| (quote-syntax Square-ref) | |
| (#%app list | |
| (#%app list | |
| 'w | |
| (quote-syntax Rectangle.w) | |
| (quote-syntax super-make-set-name-field!) | |
| (quote-syntax ()) | |
| (quote-syntax #f)) | |
| (#%app list | |
| 'h | |
| (quote-syntax Rectangle.h) | |
| (quote-syntax super-make-set-name-field!) | |
| (quote-syntax ()) | |
| (quote-syntax #f))) | |
| '#f | |
| '#(#& area #& perimeter) | |
| (quote-syntax #(area13 perimeter14)) | |
| '#hasheq((area . #& 0) (perimeter . #& 1)) | |
| (quote-syntax ((0 Square-maker) (2 #f))) | |
| '#f | |
| '#f | |
| '#f)) | |
| (define-syntaxes (|.|) (#%app make-. '#t)) | |
| (define-syntaxes (#%ref) (#%app make-#%ref '#t)) | |
| (define-values (tmp-id) | |
| (let-values ([(c) (begin | |
| (quote-syntax (#%dot-provider Circle.instance)) | |
| (#%app make-Circle '5))]) | |
| c)) | |
| (#%app call-with-values | |
| (lambda () | |
| (if (#%app Circle? tmp-id) | |
| (#%app void) | |
| (let-values () (#%app rhs-binding-failure 'val tmp-id '"Circle")))) | |
| print-values) | |
| (#%app call-with-values | |
| (lambda () | |
| (if '#t (#%app void) (let-values () (#%app rhs-binding-failure 'val tmp-id '"Circle")))) | |
| print-values) | |
| (#%app void) | |
| (define-values (c) tmp-id) | |
| (define-syntaxes (c) | |
| (#%app static-info12 | |
| (#%app list | |
| (t-quote-syntax (#%dot-provider Circle.instance)) | |
| (t-quote-syntax (#%dot-provider Circle.instance))))) | |
| (#%app call-with-values (lambda () c) print-values) | |
| (#%app call-with-values | |
| (lambda () | |
| (let-values ([(obj) c]) (#%app (#%app vector-ref (#%app Circle-ref obj) '0) obj))) | |
| print-values) | |
| (#%app call-with-values | |
| (lambda () | |
| (let-values ([(obj) c]) (#%app (#%app vector-ref (#%app Circle-ref obj) '1) obj))) | |
| print-values) | |
| (define-values (tmp-id) | |
| (let-values ([(r) (begin | |
| (quote-syntax (#%dot-provider Rectangle.instance)) | |
| (#%app make-Rectangle '3 '4))]) | |
| r)) | |
| (#%app call-with-values | |
| (lambda () | |
| (if (#%app Rectangle? tmp-id) | |
| (#%app void) | |
| (let-values () (#%app rhs-binding-failure 'val tmp-id '"Rectangle")))) | |
| print-values) | |
| (#%app | |
| call-with-values | |
| (lambda () | |
| (if '#t (#%app void) (let-values () (#%app rhs-binding-failure 'val tmp-id '"Rectangle")))) | |
| print-values) | |
| (#%app void) | |
| (define-values (r) tmp-id) | |
| (define-syntaxes (r) | |
| (#%app static-info12 | |
| (#%app list | |
| (t-quote-syntax (#%dot-provider Rectangle.instance)) | |
| (t-quote-syntax (#%dot-provider Rectangle.instance))))) | |
| (#%app call-with-values (lambda () r) print-values) | |
| (#%app call-with-values | |
| (lambda () | |
| (let-values ([(obj) r]) (#%app (#%app vector-ref (#%app Rectangle-ref obj) '0) obj))) | |
| print-values) | |
| (#%app call-with-values | |
| (lambda () | |
| (let-values ([(obj) r]) (#%app (#%app vector-ref (#%app Rectangle-ref obj) '1) obj))) | |
| print-values) | |
| (define-values (tmp-id) | |
| (let-values ([(s) (begin | |
| (quote-syntax (#%dot-provider Square.instance)) | |
| (#%app Square-ctr '10))]) | |
| s)) | |
| (#%app call-with-values | |
| (lambda () | |
| (if (#%app Square? tmp-id) | |
| (#%app void) | |
| (let-values () (#%app rhs-binding-failure 'val tmp-id '"Square")))) | |
| print-values) | |
| (#%app call-with-values | |
| (lambda () | |
| (if '#t (#%app void) (let-values () (#%app rhs-binding-failure 'val tmp-id '"Square")))) | |
| print-values) | |
| (#%app void) | |
| (define-values (s) tmp-id) | |
| (define-syntaxes (s) | |
| (#%app static-info12 | |
| (#%app list | |
| (t-quote-syntax (#%dot-provider Square.instance)) | |
| (t-quote-syntax (#%dot-provider Square.instance))))) | |
| (#%app call-with-values (lambda () s) print-values) | |
| (#%app call-with-values | |
| (lambda () | |
| (let-values ([(obj) s]) (#%app (#%app vector-ref (#%app Square-ref obj) '0) obj))) | |
| print-values) | |
| (#%app call-with-values | |
| (lambda () | |
| (let-values ([(obj) s]) (#%app (#%app vector-ref (#%app Square-ref obj) '1) obj))) | |
| print-values) | |
| (define-values (tmp-id) | |
| (let-values ([(shapes) (begin | |
| (quote-syntax (#%dot-provider list-instance)) | |
| (begin | |
| (quote-syntax (#%sequence-constructor in-list)) | |
| (begin | |
| (quote-syntax (#%map-ref list-ref)) | |
| (#%app list c r s))))]) | |
| shapes)) | |
| (#%app call-with-values | |
| (lambda () | |
| (if '#t (#%app void) (let-values () (#%app rhs-binding-failure 'val tmp-id '"Any")))) | |
| print-values) | |
| (#%app void) | |
| (define-values (shapes) tmp-id) | |
| (define-syntaxes (shapes) | |
| (#%app static-info12 | |
| (#%app list | |
| (t-quote-syntax (#%dot-provider list-instance)) | |
| (t-quote-syntax (#%sequence-constructor in-list)) | |
| (t-quote-syntax (#%map-ref list-ref))))) | |
| (#%app | |
| call-with-values | |
| (lambda () | |
| (#%app map | |
| (lambda (s29) | |
| (let-values ([(s29) s29]) | |
| (if (#%app Shape? s29) | |
| (let-values () | |
| (if '#t | |
| (let-values () | |
| (let-values ([(s) s29]) | |
| (let-values () | |
| (let-values () | |
| (let-values ([(obj) s]) | |
| (#%app (#%app vector-ref (#%app Shape-ref obj) '0) obj)))))) | |
| (let-values () (#%app argument-binding-failure 'fun s29 '"Shape")))) | |
| (let-values () (#%app argument-binding-failure 'fun s29 '"Shape"))))) | |
| shapes)) | |
| print-values))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment