add alternating->assoc-list etc.

lens/private/compound/join-hash.rkt

@@ -5,6 +5,7 @@
          unstable/sequence
          fancy-app
          "../base/main.rkt"
+         "../util/alternating-list.rkt"
          "../util/immutable.rkt"
          "../util/list-pair-contract.rkt"
          "join-list.rkt")
@@ -18,27 +19,14 @@
   [lens-join/hash (->* () #:rest (listof2 any/c lens?) (lens/c any/c immutable-hash?))]))
 
 
-(define (value-list->hash keys vs)
+(define (keys+values->hash keys vs)
-  (make-immutable-hash (map cons keys vs)))
+  (make-immutable-hash (keys+values->assoc-list keys vs)))
-
-(define (split-slice n vs)
-  (define grouped
-    (for/list ([group (in-slice n vs)])
-      group))
-  (define (get-ith i)
-    (map (list-ref _ i) grouped))
-  (build-list n get-ith))
-
-(module+ test
-  (check-equal? (split-slice 3 '(a 1 FOO b 2 BAR c 3 BAZ))
-                '((a b c) (1 2 3) (FOO BAR BAZ))))
-
 
 (define (lens-join/hash . keys/lenses)
-  (match-define (list keys lenses) (split-slice 2 keys/lenses))
+  (define-values [keys lenses] (alternating-list->keys+values keys/lenses))
   (define list-lens (apply lens-join/list lenses))
   (define (get target)
-    (value-list->hash keys (lens-view list-lens target)))
+    (keys+values->hash keys (lens-view list-lens target)))
   (define (set target new-view-hash)
     (lens-set list-lens target (map (hash-ref new-view-hash _) keys)))
   (make-lens get set))

lens/private/compound/join-list.rkt

@@ -1,26 +1,24 @@
-#lang racket/base
+#lang sweet-exp racket/base
 
-(require racket/list
+require racket/list
-         racket/contract
+        racket/contract
-         "../base/main.rkt")
+        "../base/main.rkt"
+        "../util/alternating-list.rkt"
 
-(module+ test
+module+ test
-  (require rackunit
+  require rackunit
-           "../list/list-ref-take-drop.rkt"))
+          "../list/list-ref-take-drop.rkt"
 
-(provide
+provide
- (contract-out
+  contract-out
-  [lens-join/list (->* () #:rest (listof lens?) (lens/c any/c list?))]))
+    lens-join/list (->* () #:rest (listof lens?) (lens/c any/c list?))
 
 
-(define (zip xs ys)
-  (append-map list xs ys))
-
 (define (lens-join/list . lenses)
   (define (get target)
     (apply lens-view/list target lenses))
   (define (set target new-views)
-    (apply lens-set/list target (zip lenses new-views)))
+    (apply lens-set/list target (keys+values->alternating-list lenses new-views)))
   (make-lens get set))
 
 

lens/private/util/alternating-list.rkt

@@ -0,0 +1,61 @@
+#lang sweet-exp racket/base
+
+provide alternating->assoc-list
+        assoc->alternating-list
+        keys+values->assoc-list
+        assoc-list->keys+values
+        keys+values->alternating-list
+        alternating-list->keys+values
+
+require racket/list
+        racket/match
+        unstable/sequence
+module+ test
+  require rackunit
+
+(define (alternating->assoc-list alternating-list)
+  (for/list ([lst (in-slice 2 alternating-list)])
+    (match-define (list a b) lst)
+    (cons a b)))
+
+(define (assoc->alternating-list alist)
+  (append*
+   (for/list ([(k v) (in-pairs alist)])
+     (list k v))))
+
+(define (keys+values->assoc-list keys values)
+  (map cons keys values))
+
+(define (assoc-list->keys+values alist)
+  (values (map car alist)
+          (map cdr alist)))
+
+(define (keys+values->alternating-list keys values)
+  (append-map list keys values))
+
+(define (alternating-list->keys+values alternating-list)
+  (for/lists (ks vv) ([lst (in-slice 2 alternating-list)])
+    (match-define (list k v) lst)
+    (values k v)))
+
+module+ test
+  (check-equal? (alternating->assoc-list '(a 1 b 2)) '((a . 1) (b . 2)))
+  (check-equal? (alternating->assoc-list '(b 2 a 1)) '((b . 2) (a . 1)))
+  (check-equal? (assoc->alternating-list '((a . 1) (b . 2))) '(a 1 b 2))
+  (check-equal? (assoc->alternating-list '((b . 2) (a . 1))) '(b 2 a 1))
+  (check-equal? (keys+values->assoc-list '(a b) '(1 2)) '((a . 1) (b . 2)))
+  (check-equal? (keys+values->assoc-list '(b a) '(2 1)) '((b . 2) (a . 1)))
+  (check-equal? (keys+values->alternating-list '(a b) '(1 2)) '(a 1 b 2))
+  (check-equal? (keys+values->alternating-list '(b a) '(2 1)) '(b 2 a 1))
+  (let-values ([(ks vs) (assoc-list->keys+values '((a . 1) (b . 2)))])
+    (check-equal? ks '(a b))
+    (check-equal? vs '(1 2)))
+  (let-values ([(ks vs) (assoc-list->keys+values '((b . 2) (a . 1)))])
+    (check-equal? ks '(b a))
+    (check-equal? vs '(2 1)))
+  (let-values ([(ks vs) (alternating-list->keys+values '(a 1 b 2))])
+    (check-equal? ks '(a b))
+    (check-equal? vs '(1 2)))
+  (let-values ([(ks vs) (alternating-list->keys+values '(b 2 a 1))])
+    (check-equal? ks '(b a))
+    (check-equal? vs '(2 1)))

unstable/lens/isomorphism/data.rkt

@@ -10,6 +10,7 @@ provide string->symbol-lens
         string->list-lens
 
 require lens/private/base/main
+        lens/private/util/alternating-list
         "base.rkt"
 
 module+ test
@@ -24,6 +25,8 @@ module+ test
   (make-isomorphism-lenses list->vector vector->list))
 (define-values [list->string-lens string->list-lens]
   (make-isomorphism-lenses list->string string->list))
+(define-values [alternating->assoc-list-lens assoc->alternating-list-lens]
+  (make-isomorphism-lenses alternating->assoc-list assoc->alternating-list))
 
 
 (module+ test

unstable/lens/join-assoc.rkt

@@ -5,21 +5,20 @@ provide lens-join/assoc
 require lens/private/base/main
         lens/private/compound/join-list
         lens/private/list/assoc
+        lens/private/util/alternating-list
         racket/match
         unstable/sequence
 module+ test
   require rackunit lens/private/list/main
 
 (define (lens-join/assoc . ks/lenses)
-  (match-define (list (list keys lenses) ...)
+  (define-values [keys lenses]
-    (for/list ([k/lens (in-slice 2 ks/lenses)])
+    (alternating-list->keys+values ks/lenses))
-      k/lens))
   (define key-lenses (map assoc-lens keys))
   (define list-lens (apply lens-join/list lenses))
   (make-lens
    (λ (tgt)
-     (for/list ([k (in-list keys)] [lens (in-list lenses)])
+     (keys+values->assoc-list keys (lens-view list-lens tgt)))
-       (cons k (lens-view lens tgt))))
    (λ (tgt nvw)
      (lens-set list-lens tgt (apply lens-view/list nvw key-lenses)))))