[plt-dev] I love Haskell (not an April Fools Joke!), feature request for 'for'

From: Sam TH (samth at ccs.neu.edu)
Date: Thu Apr 2 12:42:15 EDT 2009

Here's another PLT implementation:

(define (rail n l)
  (zip-sort (for/list ([i (cycle (in-range 1 (add1 n)) (in-range (sub1
n) 1 -1))] [e l])
               (cons i e))))

(define (derail n s)
  (zip-sort (map cons (rail n (for/list ([i (in-naturals)] [e s]) i)) s)))

(define (zip-sort ks/vs)
  (map cdr (sort #:key car ks/vs <)))

(apply string (rail 4 "PROGRAMMING PRAXIS"))
(apply string (derail 4 (rail 4 "PROGRAMMING PRAXIS")))

Here's the implementation of `cycle' (which should probably be in the
sequence library):

(Also the interface for `make-do-sequence' is pretty hard to use.)

(define (seq-append seq1 seq2)
  (define-values (s1? s1) (sequence-generate seq1))
  (define-values (s2? s2) (sequence-generate seq2))
  (make-do-sequence (lambda ()
                      (values (lambda (p) (if (s1?) (s1) (s2)))
                              (lambda (p) #t)
                              (lambda _ (or (s1?) (s2?)))
                              (lambda _ #t)
                              (lambda _ #t)))))

(define (cycle seq . seqs)
  (define l (reverse (cons seq seqs)))
  (define-values (s? s) (sequence-generate (foldr seq-append (car l) (cdr l))))
  (define cache null)
  (define head #f)
  (make-do-sequence (lambda ()
                      (values (lambda (p) (if p
                                              (mcar p)
                                              (let* ([v (s)]
                                                     [pr (mcons v cache)])
                                                (unless head
                                                    (set! head pr))
                                                (set! cache pr)
                              (lambda (p) (cond [(mpair? p) (mcdr p)]
                                                [(s?) #f]
                                                 (set-mcdr! head cache)
                              (lambda _ #t)
                              (lambda _ #t)
                              (lambda _ #t)))))

sam th
samth at ccs.neu.edu

Posted on the dev mailing list.