a circular dilemma . #0# (was Re: srfi-1 map!)

[Stephen Compall]

Kevin Ryde <address@hidden> writes:

> I've been finding it a bit annoying that map can handle long lists
> but map! can't.

You're right, that is annoying.  So annoying, I wrote a new version,
and ran into some problems with circular lists.

Here is the first version.  I suppose I should have used any1 instead
of the two hand-rollings, but I saw it too late.  On the same note,
you have to bring map1, an internal from srfi-1.scm, into scope.

;;see if any list in LISTLIST has only one element
(define (any-alone? listlist)
  (cond
   ((null? listlist) #f)
   ((null? (cdar listlist)) #t)
   (else (any-alone? (cdr listlist)))))

(define (s11-map! f list1 . rest)
  ;; First, make sure list1 is not empty, and rest contains no empty
  ;; lists.
  (if (or (null? list1)
          (let lp ((lists rest))
            (cond
             ((null? lists) #f)
             ((null? (car lists)) #t)
             (else (lp (cdr lists))))))
      ;; BTW, I'm going to return list1.
      (set! list1 '())
    ;; OK, all cars are conses, with real elements to callback with
    (let nextelem ((clist1 list1) (crest rest))
      (set-car! clist1 (apply f (car clist1) (map1 car crest)))
      ;; Will that be true on the next round?
      (if (or (null? (cdr clist1)) (any-alone? crest))
          ;; If not, cut the list off here
          (set-cdr! clist1 '())
        (nextelem (cdr clist1) (map1 cdr crest)))))
  list1)

Which worked wonderfully for all sorts, even with circulars in REST,
until I started setting circulars to LIST1 with "longer" (that is,
those with more cons cells) but proper lists.

guile> (define mylist (circular-list 1 2 3 4))
guile> mylist
(1 2 3 4 . #0#)
guile> (map + mylist '(0 0 0 0 0 0))
(1 2 3 4 1 2)
guile> (s11-map! + mylist '(0 0 0 0 0 0))
(1 2)

The problem is, of course, even larger when your function returns
something other than its first argument.

So I modified it like so:

(define (s11-map! f list1 . rest)
  ;; First, make sure LIST1 is not empty, and rest contains no empty
  ;; lists.
  (if (or (null? list1)
          (let lp ((lists rest))
            (cond
             ((null? lists) #f)
             ((null? (car lists)) #t)
             (else (lp (cdr lists))))))
      ;; BTW, I'm going to return LIST1.
      (set! list1 '())
    ;; OK, all cars are conses, with real elements to callback with
    (let nextelem ((clist1 list1) (crest rest))
      (set-car! clist1 (apply f (car clist1) (map1 car crest)))
      (cond
       ;; circular LIST1...append new cells instead
       ((eq? (cdr clist1) list1)
        (set-cdr! clist1 (apply map f list1 (map1 cdr crest))))
       ;; rest of system handles circulars in REST just fine
       ;; If no more elements, cut LIST1 off here
       ((or (null? (cdr clist1)) (any-alone? crest))
        (set-cdr! clist1 '()))
       (else
        (nextelem (cdr clist1) (map1 cdr crest))))))
  list1)

Of course, this doesn't compensate for the circular list being a
sublist of LIST1 (e.g. (cons* -1 0 (circular-list 1 2 3 4))), but at
least produces a list of the proper length.

guile> mylist
(1 2 3 4 . #0#)
guile> (s11-map! + mylist '(0 0 0 0 0 0))
(1 2 3 4 1 2)
guile> mylist
(1 2 3 4 1 2)

But the values!

guile> (set! mylist (circular-list 1 2 3 4))
guile> (s11-map! + mylist '(1 1 1 1 1 1))
(2 3 4 5 3 4)
guile> (map + (circular-list 1 2 3 4) '(1 1 1 1 1 1))
(2 3 4 5 2 3)

Well, that isn't good!  And of course:

guile> (set! mylist (cons* 1 2 (circular-list 3 4 5 6)))
guile> (map + mylist '(1 1 1 1 1 1 1 1))
(2 3 4 5 6 7 4 5)
guile> (s11-map! + mylist '(1 1 1 1 1 1 1 1))
(2 3 5 6)

Which is the same problem the original had.

So, is there any way out of this problem, other than to dump the
second version (which is needlessly more complicated, I now think),
and shunt any call where LIST1 doesn't meet list? to map?  Or just
live with "undefined behavior" given by the silly (IMHO) case of
having a circular as LIST1 where a list in REST has more cells?  Or
what?

Did I mention I like [my] original version better?  Yeah.

--
Stephen Compall or s11 or sirian

Logic is a pretty flower that smells bad.

SCUD missile cybercash Kosovo Ermes New World Order ASPIC KGB
government munitions satellite imagery investigation csystems
fissionable e-cash MIT-LL