From 4d307415d34176be4093bfb1536cc9a175430b20 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 1 Mar 2016 06:04:54 -0800
Subject: Fix triple-colon in ipv6 text representation.

* share/txr/stdlib/socket.tl (sys:in6addr-condensed-text): New
function containing common code. Uses window-mappend to
selectively convert a compressed range of zeros to either
colon or empty string based on whether it is in the middle
or end.
(str-in6addr, str-in6addr-net): Use new function.
---
 share/txr/stdlib/socket.tl | 35 +++++++++++++++++------------------
 1 file changed, 17 insertions(+), 18 deletions(-)

diff --git a/share/txr/stdlib/socket.tl b/share/txr/stdlib/socket.tl
index 0898a491..e911a6a7 100644
--- a/share/txr/stdlib/socket.tl
+++ b/share/txr/stdlib/socket.tl
@@ -55,6 +55,19 @@
       (throwf 'eval-error "str-inaddr: ~a out of range for IPv4 address" addr)
       `@a.@b.@c.@d@p`)))
 
+(defun sys:in6addr-condensed-text (numeric-pieces)
+  (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))))
+                  [partition-by zerop numeric-pieces])))
+    `@{texts ":"}`))
+
 (defun str-in6addr (addr : port)
   (let ((str (if (and (<= (width addr) 48)
                       (= (ash addr -32) #xFFFF))
@@ -70,15 +83,8 @@
                                                             addr))
                                                   (cons (logand val #xFFFF)
                                                         (ash val -16))))
-                                              addr)))
-                      (notyet t)
-                      (texts (append-each ((chunk [partition-by zerop pieces]))
-                               (cond
-                                 ((and notyet (zerop (car chunk)) (cdr chunk))
-                                  (zap notyet)
-                                  '(":"))
-                                 (t (mapcar (op format nil "~x") chunk))))))
-                 `@{texts ":"}`))))
+                                              addr))))
+                 (sys:in6addr-condensed-text pieces)))))
     (if port
       `[@str]:@port`
       str)))
@@ -133,12 +139,5 @@
                                                  (ash val -16))))
                                        addr)))
              (cand-prefix [pieces 0..(trunc (+ w 15) 16)])
-             (prefix (if (search cand-prefix '(0 0)) pieces cand-prefix))
-             (notyet t)
-             (texts (append-each ((chunk [partition-by zerop prefix]))
-                      (cond
-                        ((and notyet (zerop (car chunk)) (cdr chunk))
-                         (zap notyet)
-                         '(":"))
-                        (t (mapcar (op format nil "~x") chunk))))))
-             `@{texts ":"}/@w`))))
+             (prefix (if (search cand-prefix '(0 0)) pieces cand-prefix)))
+        `@(sys:in6addr-condensed-text prefix)/@w`))))
-- 
cgit v1.2.3