Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

define-record-type methods and interfaces #596

Open
wants to merge 5 commits into
base: main
Choose a base branch
from
Open

define-record-type methods and interfaces #596

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
72759db
support for define-record-type methods and interfaces, with a few oth…
dybvig Dec 4, 2021
71915d6
changed define-interface syntax; added interface predicates; some fixes
dybvig Dec 7, 2021
adbea6e
updated comments documenting the new features
dybvig Dec 7, 2021
ee3c736
improved expansion and optimization of records with methods and
dybvig Feb 4, 2022
262716d
fixed placement of $diinfo? check and improved $query-interface optim…
dybvig Feb 5, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 12 additions & 1 deletion LOG
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2308,7 +2308,7 @@
- cp0 record-construct handlers now keep record-type wrappers when
propagating constants and refs.
cp0.ss
- added immutable-vector primitiive along with cp0 handling of
- added immutable-vector primitive along with cp0 handling of
fully (foldable) and partially static immutable vectors.
primdata.ss, cpnanopass.ss, base-lang.ss, cpcheck.ss, cpletrec.ss,
cpcommonize.ss, cprep.ss, prims.ss, cp0.ss,
Expand Down Expand Up @@ -2365,3 +2365,14 @@
record.ms, root-experr-compile-0-f-f-f
- updated patch files
patch-compile-0-f-t-f, patch-compile-0-t-f-f, patch-interpret-0-f-t-f
- moved $diinfo? test above first reference to the diinfo in
$trans-open-interface. added several define-interface and
open-interface syntax-error mats to catch this and other such
problems.
record-defn.ss,
record.ms, root-experr-compile-0-f-f-f, root-experr-compile-2-f-f-f
- improved $query-interface optimization so that it optimizes to #f if
it can prove the interface rtd will not be found. added a couple of
new mats to test the optimization.
cp0.ss,
record.ms
229 changes: 206 additions & 23 deletions mats/record.ms
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9459,11 +9459,36 @@
(define-record-type baz (parent foo) (methods [bar () (super)]))
(make-baz)))

(error? ; invalid syntax
(define-interface))
(error? ; invalid syntax
(define-interface (methods [m1 (x)])))
(error? ; invalid syntax
(define-interface rat israt?))
(error? ; invalid syntax
(define-interface (rat (israt?))))
(error? ; invalid syntax
(define-interface (rat (israt?))))
(error? ; invalid syntax
(define-interface ((rat) israt?)))
(error? ; invalid syntax
(define-interface (rat israt?) (methods . none)))
(error? ; invalid syntax
(define-interface (rat israt?) (methods a b c)))
(error? ; invalid syntax
(define-interface rat (mehtods)))
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more. 

(define-interface rat (mehtods))

should be

(define-interface rat (methods))

(error? ; invalid syntax
(define-interface rat (sealed #t)))
(error? ; invalid syntax
(define-interface rat (parent)))
(error? ; invalid syntax
(define-interface rat (parent p1 p2)))

; Verify that we can't define a generic for a method with the same name
; as an interface method, i.e., supply an implementation of an
; interface-inherited method with the wrong arity
(begin
(define-interface bonk (methods [whack (a mole)]))
(define-interface (bonk isbonk?) (methods [whack (a mole)]))
#t)
(error? ; invalid arity for whack
(define-record-type pewter
Expand Down Expand Up @@ -10037,6 +10062,46 @@
(define-record-type a (parent this-parent-should-be-undefined))
(make-a)))
(begin (print-record #t) (print-record))
(error? ; invalid syntax
(open-interface))
(error? ; invalid syntax
(open-interface y))
(error? ; invalid syntax
(open-interface I y))
(error? ; invalid syntax
(open-interface I y ([m m])))
(error? ; invalid syntax
(open-interface I y ([m m]) x y))
(error? ; invalid syntax
(open-interface ([m m]) I x))
(error? ; invalid syntax
(open-interface I ([m 7]) y))
(error? ; invalid syntax
(open-interface I ([m1 m1] [7 m2]) y))
(error? ; unrecognized interface
(open-interface <probably-not-defined> ([m1 m1]) x))
(error? ; no method in interface
(let ()
(define-interface <A> (methods (m1 (x))))
(define-record-type A
(implements <A>)
(fields x)
(methods [m1 (y) (list 'A 'm1 x y)]))
(define a (make-A 23))
(open-interface <A> ([a.m1 m1] [a.m2 m2]) a)
(a.m1 3)))
(error? ; duplicate local method name
(let ()
(define-interface <A> (methods (m1 (x)) (m2 (y))))
(define-record-type A
(implements <A>)
(fields x)
(methods
[m1 (y) (list 'A 'm1 x y)]
[m2 (y) (list 'A 'm2 x y)]))
(define a (make-A 23))
(open-interface <A> ([foo m1] [foo m2]) a)
(foo 3)))
(equal?
(let ()
(define-interface <A> (methods (m1 (x))))
Expand Down Expand Up @@ -10085,28 +10150,146 @@
(C m3 53 67 71 13)
(C m1 53 67 71 17)
(C m2 53 67 71 19)))
(error? ; no method in interface
(let ()
(define-interface <A> (methods (m1 (x))))
(define-record-type A
(implements <A>)
(fields x)
(methods [m1 (y) (list 'A 'm1 x y)]))
(define a (make-A 23))
(open-interface <A> ([a.m1 m1] [a.m2 m2]) a)
(a.m1 3)))
(error? ; duplicate local method name
(let ()
(define-interface <A> (methods (m1 (x)) (m2 (y))))
(define-record-type A
(implements <A>)
(fields x)
(methods
[m1 (y) (list 'A 'm1 x y)]
[m2 (y) (list 'A 'm2 x y)]))
(define a (make-A 23))
(open-interface <A> ([foo m1] [foo m2]) a)
(foo 3)))
(equivalent-expansion? ; optimize-level 2 expansion of above
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(let ()
(define-interface <A> (methods (m1 (x))))
(define-interface <B> (methods (m2 (x))))
(define-interface <C> (parent <A>) (methods (m3 (x))))
(define-record-type A
(implements <A>)
(fields x)
(methods [m1 (y) (list 'A 'm1 x y)]))
(define-record-type B
(implements <B>)
(fields x y)
(methods [m2 (z) (list 'B 'm2 x y z)]))
(define-record-type C
(implements <B> <C>)
(fields x y z)
(methods
[m1 (w) (list 'C 'm1 x y z w)]
[m2 (w) (list 'C 'm2 x y z w)]
[m3 (w) (list 'C 'm3 x y z w)]
[m4 (w) (list 'C 'm4 x y z w)]))
(define a (make-A 23))
(define b (make-B 31 47))
(define c (make-C 53 67 71))
(open-interface <A> ([a.m1 m1]) a)
(open-interface <B> ([b.m2 m2]) b)
(open-interface <C> ([c.m1 m1] [c.m3 m3]) c)
(open-interface <A> ([c.m1^ m1]) c)
(open-interface <B> ([c.m2^ m2]) c)
(list
(list (<A>? a) (<A>? b) (<A>? c))
(list (<B>? a) (<B>? b) (<B>? c))
(list (<C>? a) (<C>? b) (<C>? c))
(a.m1 3)
(b.m2 5)
(c.m1 7)
(c.m3 13)
(c.m1^ 17)
(c.m2^ 19)))))
`(letrec ,list? ; useless bindings that go away with three cp0 iterations
(#2%list (#2%list #t #f #t) (#2%list #f #t #t) (#2%list #f #f #t)
(#2%list 'A 'm1 23 3) (#2%list 'B 'm2 31 47 5)
(#2%list 'C 'm1 53 67 71 7) (#2%list 'C 'm3 53 67 71 13)
(#2%list 'C 'm1 53 67 71 17) (#2%list 'C 'm2 53 67 71 19))))
(equal?
(with-output-to-string
(lambda ()
(define-interface <A> (methods (m1 (x))))
(define-interface <B> (methods (m2 (x))))
(define-interface <C> (parent <A>) (methods (m3 (x))))
(define-record-type A
(implements <A>)
(fields x)
(methods [m1 (y) (list 'A 'm1 x y)]))
(define-record-type B
(implements <B>)
(fields x y)
(methods [m2 (z) (list 'B 'm2 x y z)]))
(define-record-type C
(implements <B> <C>)
(fields x y z)
(methods
[m1 (w) (list 'C 'm1 x y z w)]
[m2 (w) (list 'C 'm2 x y z w)]
[m3 (w) (list 'C 'm3 x y z w)]
[m4 (w) (list 'C 'm4 x y z w)]))
(define a (begin (write 1) (make-A 23)))
(define b (make-B 31 47))
(define c (begin (write 2) (make-C 53 67 71)))
(open-interface <A> ([a.m1 m1]) a)
(open-interface <B> ([b.m2 m2]) (begin (write 3) b))
(open-interface <C> ([c.m1 m1] [c.m3 m3]) c)
(open-interface <A> ([c.m1^ m1]) (begin (write 4) c))
(open-interface <B> ([c.m2^ m2]) c)
(write
(list
(list (<A>? (begin (write 6) a)) (<A>? b) (<A>? c))
(list (<B>? a) (<B>? b) (<B>? c))
(list (<C>? a) (<C>? b) (<C>? c))
((begin (write 6) a.m1) 3)
(b.m2 5)
(c.m1 (begin (write 6) 7))
(c.m3 13)
(c.m1^ 17)
(c.m2^ 19)))))
"1234666((#t #f #t) (#f #t #t) (#f #f #t) (A m1 23 3) (B m2 31 47 5) (C m1 53 67 71 7) (C m3 53 67 71 13) (C m1 53 67 71 17) (C m2 53 67 71 19))")
(equivalent-expansion? ; optimize-level 2 expansion of above
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(let ()
(define-interface <A> (methods (m1 (x))))
(define-interface <B> (methods (m2 (x))))
(define-interface <C> (parent <A>) (methods (m3 (x))))
(define-record-type A
(implements <A>)
(fields x)
(methods [m1 (y) (list 'A 'm1 x y)]))
(define-record-type B
(implements <B>)
(fields x y)
(methods [m2 (z) (list 'B 'm2 x y z)]))
(define-record-type C
(implements <B> <C>)
(fields x y z)
(methods
[m1 (w) (list 'C 'm1 x y z w)]
[m2 (w) (list 'C 'm2 x y z w)]
[m3 (w) (list 'C 'm3 x y z w)]
[m4 (w) (list 'C 'm4 x y z w)]))
(define a (begin (write 1) (make-A 23)))
(define b (make-B 31 47))
(define c (begin (write 2) (make-C 53 67 71)))
(open-interface <A> ([a.m1 m1]) a)
(open-interface <B> ([b.m2 m2]) (begin (write 3) b))
(open-interface <C> ([c.m1 m1] [c.m3 m3]) c)
(open-interface <A> ([c.m1^ m1]) (begin (write 4) c))
(open-interface <B> ([c.m2^ m2]) c)
(write
(list
(list (<A>? (begin (write 6) a)) (<A>? b) (<A>? c))
(list (<B>? a) (<B>? b) (<B>? c))
(list (<C>? a) (<C>? b) (<C>? c))
((begin (write 6) a.m1) 3)
(b.m2 5)
(c.m1 (begin (write 6) 7))
(c.m3 13)
(c.m1^ 17)
(c.m2^ 19))))))
`(letrec ,list? ; useless bindings that go away with three cp0 iterations
(#2%write 1)
(#2%write 2)
(#2%write 3)
(#2%write 4)
(#2%write
(#2%list (#2%list (begin (#2%write 6) #t) #f #t) (#2%list #f #t #t) (#2%list #f #f #t)
(begin (#2%write 6) (#2%list 'A 'm1 23 3)) (#2%list 'B 'm2 31 47 5)
(begin (#2%write 6) (#2%list 'C 'm1 53 67 71 7)) (#2%list 'C 'm3 53 67 71 13)
(#2%list 'C 'm1 53 67 71 17) (#2%list 'C 'm2 53 67 71 19)))))
)

(mat oop-contributed
Expand Down
21 changes: 21 additions & 0 deletions mats/root-experr-compile-0-f-f-f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7904,6 +7904,18 @@ record.mo:Expected error in mat oop: "m1: not applicable to 17".
record.mo:Expected error in mat oop: "arity not supported by base record-type method hit".
record.mo:Expected error in mat oop: "a record type with methods or interfaces cannot be nongenerative (define-record-type b (parent a) (nongenerative) (methods (m1 (...) (...))))".
record.mo:Expected error in mat oop: "no inherited bar method for baz in (super)".
record.mo:Expected error in mat oop: "invalid syntax (define-interface)".
record.mo:Expected error in mat oop: "invalid syntax (define-interface (methods (m1 (...))))".
record.mo:Expected error in mat oop: "invalid define-interface clause israt?".
record.mo:Expected error in mat oop: "invalid syntax (define-interface (rat (israt?)))".
record.mo:Expected error in mat oop: "invalid syntax (define-interface (rat (israt?)))".
record.mo:Expected error in mat oop: "invalid syntax (define-interface ((rat) israt?))".
record.mo:Expected error in mat oop: "invalid define-interface clause (methods . none)".
record.mo:Expected error in mat oop: "invalid method specifier c".
record.mo:Expected error in mat oop: "invalid define-interface clause (mehtods)".
record.mo:Expected error in mat oop: "invalid define-interface clause (sealed #t)".
record.mo:Expected error in mat oop: "invalid define-interface clause (parent)".
record.mo:Expected error in mat oop: "invalid define-interface clause (parent p1 p2)".
record.mo:Expected error in mat oop: "arity not supported by interface method whack".
record.mo:Expected error in mat oop: "arity not supported by interface method whack".
record.mo:Expected error in mat oop: "arity not supported by interface method whack".
Expand Down Expand Up @@ -7934,6 +7946,15 @@ record.mo:Expected error in mat oop: "all ancestors of a record type with method
record.mo:Expected error in mat oop: "m1: not applicable to #<record of type b>".
record.mo:Expected error in mat oop: "m1: not applicable to #<record of type b>".
record.mo:Expected error in mat oop: "define-record-type: unrecognized parent record type this-parent-should-be-undefined".
record.mo:Expected error in mat oop: "invalid syntax (open-interface)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface y)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface I y)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface I y ((m m)))".
record.mo:Expected error in mat oop: "invalid syntax (open-interface I y ((m m)) x y)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface ((m m)) I x)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface I ((m 7)) y)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface I ((m1 m1) (7 m2)) y)".
record.mo:Expected error in mat oop: "unrecognized interface <probably-not-defined>".
record.mo:Expected error in mat oop: "unrecognized interface method name m2".
record.mo:Expected error in mat oop: "duplicate local method name foo in (open-interface <A> ((foo m1) (foo m2)) a)".
record.mo:Expected error in mat oop-contributed: "incorrect number of arguments to #<procedure>".
Expand Down
22 changes: 22 additions & 0 deletions mats/root-experr-compile-2-f-f-f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7904,6 +7904,18 @@ record.mo:Expected error in mat oop: "m1: not applicable to 17".
record.mo:Expected error in mat oop: "arity not supported by base record-type method hit".
record.mo:Expected error in mat oop: "a record type with methods or interfaces cannot be nongenerative (define-record-type b (parent a) (nongenerative) (methods (m1 (...) (...))))".
record.mo:Expected error in mat oop: "no inherited bar method for baz in (super)".
record.mo:Expected error in mat oop: "invalid syntax (define-interface)".
record.mo:Expected error in mat oop: "invalid syntax (define-interface (methods (m1 (...))))".
record.mo:Expected error in mat oop: "invalid define-interface clause israt?".
record.mo:Expected error in mat oop: "invalid syntax (define-interface (rat (israt?)))".
record.mo:Expected error in mat oop: "invalid syntax (define-interface (rat (israt?)))".
record.mo:Expected error in mat oop: "invalid syntax (define-interface ((rat) israt?))".
record.mo:Expected error in mat oop: "invalid define-interface clause (methods . none)".
record.mo:Expected error in mat oop: "invalid method specifier c".
record.mo:Expected error in mat oop: "invalid define-interface clause (mehtods)".
record.mo:Expected error in mat oop: "invalid define-interface clause (sealed #t)".
record.mo:Expected error in mat oop: "invalid define-interface clause (parent)".
record.mo:Expected error in mat oop: "invalid define-interface clause (parent p1 p2)".
record.mo:Expected error in mat oop: "arity not supported by interface method whack".
record.mo:Expected error in mat oop: "arity not supported by interface method whack".
record.mo:Expected error in mat oop: "arity not supported by interface method whack".
Expand Down Expand Up @@ -7934,7 +7946,17 @@ record.mo:Expected error in mat oop: "all ancestors of a record type with method
record.mo:Expected error in mat oop: "m1: not applicable to #<record of type b>".
record.mo:Expected error in mat oop: "m1: not applicable to #<record of type b>".
record.mo:Expected error in mat oop: "define-record-type: unrecognized parent record type this-parent-should-be-undefined".
record.mo:Expected error in mat oop: "invalid syntax (open-interface)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface y)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface I y)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface I y ((m m)))".
record.mo:Expected error in mat oop: "invalid syntax (open-interface I y ((m m)) x y)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface ((m m)) I x)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface I ((m 7)) y)".
record.mo:Expected error in mat oop: "invalid syntax (open-interface I ((m1 m1) (7 m2)) y)".
record.mo:Expected error in mat oop: "unrecognized interface <probably-not-defined>".
record.mo:Expected error in mat oop: "unrecognized interface method name m2".
record.mo:Expected error in mat oop: "duplicate local method name foo in (open-interface <A> ((foo m1) (foo m2)) a)".
record.mo:Expected error in mat oop-contributed: "incorrect number of arguments to #<procedure>".
record.mo:Expected error in mat oop-contributed: "no inherited foo method for <a> in (super)".
record.mo:Expected error in mat oop-contributed: "multiple definitions for Repeat and other identifiers in body (let () (define-record-type Repeat (parent <root>) (fields) (protocol (...)) (methods)) (define-record-type Repeat (parent <root>) (fields) (protocol (...)) (methods)) 0)".
Expand Down
33 changes: 17 additions & 16 deletions s/cp0.ss
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2779,22 +2779,23 @@
(let ([iface-rtd d])
(nanopass-case (Lsrc Expr) ego-e
[(record ,rtd0 (record-type ,rtd1 ,rtd-expr ,maybe-base-rtd (,e* ...) ,extra* ...) ,e0* ...)
(let loop ([e* e*])
(and (not (null? e*))
(nanopass-case (Lsrc Expr) (car e*)
[(ref ,maybe-src ,x) #t]
[else #f])
(or (nanopass-case (Lsrc Expr) (indirect-ref (car e*))
[(record ,rtd ,rtd-expr ,e2* ...)
(guard
(let f ([rtd rtd])
(or (eq? rtd iface-rtd)
(let ([rtd (record-type-parent rtd)])
(and rtd (f rtd))))))
(residualize-seq '() (list x y) ctxt)
(car e*)]
[else #f])
(loop (cdr e*)))))]
(let loop ([e* e*] [known-false? #t])
(if (null? e*)
(and known-false?
(begin
(residualize-seq '() (list x y) ctxt)
false-rec))
(nanopass-case (Lsrc Expr) (indirect-ref (car e*))
[(record ,rtd ,rtd-expr ,e2* ...)
(if (let f ([rtd rtd])
(or (eq? rtd iface-rtd)
(let ([rtd (record-type-parent rtd)])
(and rtd (f rtd)))))
(begin
(residualize-seq '() (list x y) ctxt)
(car e*))
(loop (cdr e*) known-false?))]
[else (loop (cdr e*) #f)])))]
[else #f]))]
[else #f]))])

Expand Down
Loading