TXR Lisp:

Using quasiquote-style pattern:

(if-match ^#S(point x ,x y ,y) obj
(prinl (+ x y))

Or using @(struct ...) pattern operator:

(if-match @(struct point x @x y @y) obj
(prinl (+ x y))

All done with macros. Expansion, compilation, disassembly:

4> (flow '(if-match @(struct point x @x y @y) (new (point 1 2))
(prinl (+ x y)))
expand
prinl
compile-toplevel
disassemble)
(let ((#:g0062 (struct-from-args 'point 1 2)))
(let* (#:result-0065
x y)
(if (if (subtypep (typeof #:g0062)
'point)
(let ((#:x0063 (slot #:g0062 'x))
(#:y0064 (slot #:g0062 'y)))
(sys:setq x #:x0063)
(sys:setq y #:y0064)
(sys:setq #:result-0065
(prinl (+ x y)))
t))
#:result-0065
())))
data:
0: point
1: 1
2: 2
3: x
4: y
syms:
0: struct-from-args
1: subtypep
2: typeof
3: slot
4: prinl
5: sys:b+
code:
0: 2003000E gcall t14 0 d0 d1 d2
1: 04000000
2: 04020401
3: 20010005 gcall t5 2 t14
4: 000E0002
5: 20020002 gcall t2 1 t5 d0
6: 00050001
7: 00000400
8: 38000016 if t2 22
9: 00000002
10: 2002000A gcall t10 3 t14 d3
11: 000E0003
12: 00000403
13: 20020009 gcall t9 3 t14 d4
14: 000E0003
15: 00000404
16: 20020006 gcall t6 5 t10 t9
17: 000A0005
18: 00000009
19: 2001000D gcall t13 4 t6
20: 00060004
21: 1000000D end t13
22: 10000000 end nil
instruction count:
10
#<sys:vm-desc: 9966330>

I see this is doing something silly: (subtypep (typeof x) y) is just (typep x y), but costs an extra gcall instruction.

Either the pattern matcher should do this, or the compiler should have that as an algebraic reduction, or both.

Let's do the compiler for fun:

$ git diff stdlib
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl
index 58685741..a837571e 100644
--- a/stdlib/compiler.tl
+++ b/stdlib/compiler.tl
@@ -1411,6 +1411,8 @@ (defmeth compiler comp-fun-form (me oreg env form)
(set form (rlcp ^(,bin ,a ,b) form)))
((- @a)
(set form (rlcp ^(neg ,a) form)))
+ ((subtypep (typeof @a) @b)
+ (set form (rlcp ^(typep ,a ,b) form)))
((@(or ignore nilf) . @args)
(if (eql sym 'ignore)
(each ((a args))

Note that we are using pattern matching here to recognize and rewrite this case. In return we will obtain better code from pattern matching:

$ make
TXR stdlib/compiler.tl -> stdlib/compiler.tlo
$ ./txr
This is the TXR Lisp interactive listener of TXR 291.
Quit with :quit or Ctrl-D on an empty line. Ctrl-X ? for cheatsheet.
TXR is not a toy, but should be kept within easy reach of children.
1> (flow '(if-match @(struct point x @x y @y) (new (point 1 2))
(prinl (+ x y)))
expand
prinl
compile-toplevel
disassemble)
(let ((#:g0024 (struct-from-args 'point 1 2)))
(let* (#:result-0028
x y)
(if (if (subtypep (typeof #:g0024) ;; this hasn't changed, of course
'point)
(let ((#:x0026 (slot #:g0024 'x))
(#:y0027 (slot #:g0024 'y)))
(sys:setq x #:x0026)
(sys:setq y #:y0027)
(sys:setq #:result-0028
(prinl (+ x y)))
t))
#:result-0028
())))
** expr-1:1: warning: if-match: no such struct type: point
** expr-1:1: warning: new: point does not name a struct type
data:
0: point
1: 1
2: 2
3: x
4: y
syms:
0: struct-from-args
1: typep ;;; no mention of subtypep here any more!
2: slot
3: prinl
4: sys:b+
code:
0: 2003000E gcall t14 0 d0 d1 d2
1: 04000000
2: 04020401
3: 20020002 gcall t2 1 t14 d0
4: 000E0001
5: 00000400
6: 38000014 if t2 20
7: 00000002
8: 2002000A gcall t10 2 t14 d3
9: 000E0002
10: 00000403
11: 20020009 gcall t9 2 t14 d4
12: 000E0002
13: 00000404
14: 20020006 gcall t6 4 t10 t9
15: 000A0004
16: 00000009
17: 2001000D gcall t13 3 t6
18: 00060003
19: 1000000D end t13
20: 10000000 end nil
instruction count:
9 ;; down by one
#<sys:vm-desc: 92c94d0>

Ship it!