Thanks to Jos Koot from comp.lang.scheme, I have managed to make the macro multithread friendly, it does however ‘uglify’ the macro quite a bit.

Also optimized the sort proc generation and fixed a small bug that prevented it from running on other R6RS Schemes

UPDATE: removed unnecessary syntax to/from datum conversion (thanks Aziz).

UPDATE 2: There is a problem with the nested ‘from x in y’.

(import (rnrs))

(define (compare asc? a b)
  (cond
    [(and (number? a) (number? b))
      ((if asc? < >) a b)]
    [(and (char? a) (char? b))
      ((if asc? char<? char>?) a b)]
    [(and (string? a) (string? b))
      ((if asc? string<? string>?) a b)]
    [(and (symbol? a) (symbol? b))
        (let ((a (symbol->string a))
              (b (symbol->string b)))
           ((if asc? string<? string>?) a b))]
    [else
      (assertion-violation 'compare "not supported" a b)]))

(define (sort asc? l a b)
  (list-sort
    (lambda (a* b*)
      (compare asc? (a a*) (b b*)))
    l))

(define (flatten lists)
  (apply append lists))

(define-syntax from
  (lambda (x)
    (letrec
      ((v ‘())
       (id=?
          (lambda (e o)
            (eq? (syntax->datum e) o)))
       (arg
          (lambda (e)
            (if (= 1 (length v))
              (datum->syntax e `(list ,(syntax->datum e)))
              e)))
       (init
          (lambda (e)
            (when (= 0 (length v))
              (set! v (list e)))))
       (from*
          (lambda (x)
            (syntax-case x (in select)
              [(e in l select s)
                (identifier? #'e)
                (begin
                  (init #'e) ; bind
                   #`(map
                      (lambda (e)
                        (apply
                          (lambda (#,@v) s)
                          #,(arg #'e)))
                      l))]
              [(e in l c ... select s)
                (identifier? #'e)
                (begin
                  (init #'e) ; bind
                  (syntax-case #'(c ...) (where let = in orderby)
                    [(where p rest ...)
                      (from* #`(e in
                          (filter
                            (lambda (e)
                              (apply
                                (lambda (#,@v) p)
                                #,(arg #'e)))
                            l)
                         rest ...
                         select s))]
                    [(let y = y* rest ...)
                      (identifier? #'y)
                      (let ((v* v)
                            (a* (arg #'e)))
                        (set! v (cons #'y v))
                        (from* #`(e in
                            (map
                              (lambda (e)
                                (apply
                                  (lambda (#,@v*)
                                    (list y* #,@v*))
                                  #,a*))
                              l)
                           rest ...
                           select s)))]
                    [(from e* in l* rest ...)
                      #`(flatten
                          #,(from* #'(e in l
                             select
                              (from e* in l*
                               rest ...
                               select s))))]
                    [(orderby p dir rest ...)
                      (or (id=? #'dir 'asc) (id=? #'dir 'desc))
                      (from* #`(e in
                          (let ((p*
                            (lambda (e)
                              (apply
                                (lambda (#,@v) p)
                                #,(arg #'e)))))
                            (sort #,(id=? #'dir 'asc) l p* p*))
                         rest ...
                         select s))]
                    [(orderby p rest ...)
                      (from* #'(e in l
                         orderby p asc
                         rest ...
                         select s))]
                ))]))))
         (syntax-case x ()
            [(from . rest)
              (from* #'rest)]))))

; sample usage
(define al ‘((a 4) (d 3) (a 2) (c 9) (a 11)))

(write
  [
  from y in al
  let a = (car y)  ; the symbol
  let b = (cadr y) ; the number
  let c = y        ; alias
  orderby b
  where (and (eq? a 'a) (even? b))
  from x in c
  let d = x
  select d
  ])
(newline) ;=> (a 2 a 4)

Your response: