Skip to content

Instantly share code, notes, and snippets.

@samdphillips

samdphillips/aa-shapes.rhm

Last active November 11, 2022 03:25
Show Gist options
  • Save samdphillips/2ceb10fbe05e18c0c7cb00d920b48a5d to your computer and use it in GitHub Desktop.
Save samdphillips/2ceb10fbe05e18c0c7cb00d920b48a5d to your computer and use it in GitHub Desktop.
Download ZIP
Rhombus with class
Raw
aa-shapes.rhm
#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)
Raw
ab-shapes-expanded.rkt
(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