summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2020-05-01 06:16:28 -0700
committerKaz Kylheku <kaz@kylheku.com>2020-05-01 06:16:28 -0700
commit558640ed753811be1be60422415f8dd92b6af5f0 (patch)
tree186c39dfd048a86d463626b26fd65c29efc4ba05
parent9c32e8b4bd0e14a323597977ea7c9e5997a30e97 (diff)
downloadtxr-558640ed753811be1be60422415f8dd92b6af5f0.tar.gz
txr-558640ed753811be1be60422415f8dd92b6af5f0.tar.bz2
txr-558640ed753811be1be60422415f8dd92b6af5f0.zip
sockets: ipv6 address condensing rewrite.
* share/txr/stdlib/socket.tl (sys:in6addr-condensed-text): Rewrite with regex based implementation that formats the number without condensing. This one has better semantics in that it finds the longest run of 0.0..0 to replace, rather than the leftmost. Ignoring this semantic difference, it also has better average performance on pseudo-random addresses, with similar performance on addresses with long condensable 0's. The original algorithm has a significantly poorer average case on random addresses, but better best case on condensable zeros like 1::1. The new algorithm could improve further with future work to make regexes faster.
-rw-r--r--share/txr/stdlib/socket.tl26
1 files changed, 12 insertions, 14 deletions
diff --git a/share/txr/stdlib/socket.tl b/share/txr/stdlib/socket.tl
index 2571aef1..3236460c 100644
--- a/share/txr/stdlib/socket.tl
+++ b/share/txr/stdlib/socket.tl
@@ -61,21 +61,19 @@
'str-inaddr addr)
`@a.@b.@c.@d@p`)))
+
(defun sys:in6addr-condensed-text (numeric-pieces)
- (let ((parted [partition-by zerop numeric-pieces]))
- (if (or (cdr parted) (nzerop (caar parted)))
- (let* ((notyet t)
- (texts (window-mappend
- 1 nil
- (lambda (pre chunk post)
- (cond
- ((and notyet (zerop (car chunk)) (cdr chunk))
- (zap notyet)
- (if (and post pre) '("") '(":")))
- (t (mapcar (op format nil "~x") chunk))))
- parted)))
- `@{texts ":"}`)
- "::")))
+ (let* ((str (cat-str [mapcar (load-time (op fmt "~x")) numeric-pieces] ":"))
+ (zr (rra #/0(:0)+/ str))
+ (lp [pos-max zr : (load-time [callf - to from])])
+ (lr [zr lp]))
+ (when lp
+ (del [str lr]))
+ (cond
+ ((equal "" str) "::")
+ ((starts-with ":" str) `:@str`)
+ ((ends-with ":" str) `@str:`)
+ (t str))))
(defun str-in6addr (addr : port)
(let ((str (if (and (<= (width addr) 48)