| 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! |