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

That's nearly the same I sent.


On Apr 2, 2009, at 12:42 PM, Sam TH wrote:

> 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)
>                               #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)
>                                                 v)))
>                               (lambda (p) (cond [(mpair? p) (mcdr p)]
>                                                 [(s?) #f]
>                                                 [else
>                                                  (set-mcdr! head  
> cache)
>                                                  head]))
>                               #f
>                               (lambda _ #t)
>                               (lambda _ #t)
>                               (lambda _ #t)))))
>
>
> -- 
> sam th
> samth at ccs.neu.edu