Now completely rewritten. Supports all the non-grouping constructs for now. From what I can see, this is quite similar to the LISP FOR construct.

Tested on IronScheme, Ikarus and Petite Chez.

(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 lst)
  (apply append lst))

(define-syntax bind
  (syntax-rules ()
    [(bind var body)
      (lambda (var) body)]
    [(bind vars ... body)
      (lambda (K)
        (apply
          (lambda (vars ...) body)
          K))]))

(define-syntax from
  (lambda (x)
    (define valid-id?
      (lambda (e vars)
         (and (identifier? e)
           (not (memp
                  (lambda (x)
                    (bound-identifier=? e x))
                  vars)))))
    (define id=?
      (lambda (e o)
        (eq? (syntax->datum e) o)))
    (syntax-case x (in)
      [(_ e in l rest ...)
        (identifier? #'e)
        (let recur ((vars (list #'e))
                    (l #'l)
                    (x* #'(rest ...)))
          (syntax-case x* (where let = in select from orderby join equals on)
            [() (syntax-violation 'from "missing select" x)]
            [(select s)
              #`(map (bind #,@vars s) #,l)]
            [(where p rest ...)
              (recur vars
                #`(filter (bind #,@vars p) #,l)
                #'(rest ...))]
            [(from e* in l* rest ...)
              (if (valid-id? #'e* vars)
                (recur (cons #'e* vars)
                  #`(flatten
                      (map
                        (bind #,@vars
                          (map
                            (lambda (K*)
                              (list K* #,@vars))
                            l*))
                        #,l))
                   #'(rest ...))
                (syntax-violation 'from "not a unique identifier" #'e* x*))]
            [(let a = b rest ...)
              (if (valid-id? #'a vars)
                (recur (cons #'a vars)
                  #`(map (bind #,@vars (list b #,@vars)) #,l)
                  #'(rest ...))
                (syntax-violation 'from "not a unique identifier" #'a x*))]
            [(orderby p dir rest ...)
              (or (id=? #'dir 'asc) (id=? #'dir 'desc))
              (recur vars
                #`(let* ((p*
                    (bind #,@vars p)))
                    (sort #,(id=? #'dir 'asc) #,l p* p*))
                #'(rest ...))]
            [(orderby p rest ...)
              (recur vars l #'(orderby p asc rest ...))]
            [(join e* in l* on a equals b rest ...)
              (recur vars l
                #'(from e* in l* where (eqv? a b) rest ...))]
            ))])))

Fixed the nested ‘from x in y’ problem

Thanks to Jos, Aziz and Andre for tips on comp.lang.scheme.

(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
      ((vars ‘())
       (id=?
          (lambda (e o)
            (eq? (syntax->datum e) o)))
       (arg
          (lambda (e)
            (if (= 1 (length vars))
              (datum->syntax e `(list ,(syntax->datum e)))
              e)))
       (init
          (lambda (e)
            (when (null? vars)
              (set! vars (list e)))))
       (valid-id?
          (lambda (e)
            (and (identifier? e)
              (not (memp
                     (lambda (x)
                       (bound-identifier=? e x))
                     vars)))))
       (from*
          (lambda (x)
            (syntax-case x (in select)
              [(e in l select s)
                (identifier? #'e)
                (begin
                  (init #'e) ; bind
                   #`(map
                      (lambda (K)
                        (apply
                          (lambda (#,@vars) s)
                          #,(arg #'K)))
                      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 (K)
                              (apply
                                (lambda (#,@vars) p)
                                #,(arg #'K)))
                            l)
                         rest ...
                         select s))]
                    [(let y = y* rest ...)
                      (valid-id? #'y)
                      (let ((v* vars)
                            (a* (arg #'K)))
                        (set! vars (cons #'y vars))
                        (from* #`(e in
                            (map
                              (lambda (K)
                                (apply
                                  (lambda (#,@v*)
                                    (list y* #,@v*))
                                  #,a*))
                              l)
                           rest ...
                           select s)))]
                    [(from e* in l* rest ...)
                      (valid-id? #'e*)
                      (let ((v* vars)
                            (a* (arg #'K)))
                        (set! vars (cons #'e* vars))
                        (from* #`(e in
                              (flatten
                                (map
                                  (lambda (K)
                                    (apply
                                      (lambda (#,@v*)
                                        (map
                                          (lambda (K*)
                                            (list K* #,@v*))
                                        l*))
                                      #,a*))
                                  l))
                           rest ...
                           select s)))]
                    [(orderby p dir rest ...)
                      (or (id=? #'dir 'asc) (id=? #'dir 'desc))
                      (from* #`(e in
                          (let ((p*
                            (lambda (K)
                              (apply
                                (lambda (#,@vars) p)
                                #,(arg #'K)))))
                            (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)]))))

Example:

(define args (list (string->list “hello”) (string->list “world”)))

(display
  [
    from K in args
    from K* in K
    where (not (char=? #\l K*))
    orderby K*
    select K*
  ])
(newline) ;=> (d e h o o r w)

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)

Added the ‘let x = y’ construct

This required some substantial reworking, but it works much easier now.

Next I will look at joins and groupby’s as well as constructing ‘delayed’ queries as in C#.

(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
  (let ((v ‘()))
    (lambda (x)
      (define (id=? e o)
        (eq? (syntax->datum e) o))
      (define (vars e)
        (datum->syntax e v))
      (define (arg e)
        (if (= 1 (length v))
          (datum->syntax e `(list ,(syntax->datum e)))
          e))
      (define (init e)
        (when (= 0 (length v))
          (set! v (cons (syntax->datum e)))))
      (syntax-case x (in select)
        [(from e in l select s)
          (identifier? #'e)
          (begin
            (init #'e) ; bind
            (let ((r
               #`(map
                  (lambda (e)
                    (apply
                      (lambda #,(vars #'e) s)
                      #,(arg #'e)))
                  l)))
                (set! v '()) ; reset v  
                r))]
        [(from 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 #,(vars #'e) p)
                          #,(arg #'e)))
                      l)
                   rest ...
                   select s)]
              [(let y = y* rest ...)
                (identifier? #'y)
                (let ((v* (vars #'e))
                      (a* (arg #'e)))
                  (set! v (cons (syntax->datum #'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
                    (sort #,(id=? #'dir 'asc) l
                      (lambda (e)
                        (apply
                          (lambda #,(vars #'e) p)
                          #,(arg #'e)))
                      (lambda (e)
                        (apply
                          (lambda #,(vars #'e) p)
                          #,(arg #'e))))
                   rest ...
                   select s)]
              [(orderby p rest ...)
                #'(from e in l
                   orderby p asc
                   rest ...
                   select s)]
          ))]))))

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 asc
  where (and (eq? a 'a) (even? b))
  from x in c
  let d = x
  select d
  ])
(newline) ;=> (a 2 a 4)

Rules:
- No duplicate identifiers
- from and let requires an unique identifier
- you can use normal expressions in the latter parts of from and let, as well as select, where and orderby

I have managed to get the lexical scoping working

This works on the following:
- IronScheme
- Ikarus
- Larceny
- Petite Chez Scheme (remove the import clause)

Implementation:

(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)
    (define (e? e o)
      (eq? (syntax->datum e) (syntax->datum o)))
    (syntax-case x (in select)
      [(from e in l select s)
        (identifier? #'e)
        (if (e? #'e #'s)
          #'l
          #'(map (lambda (e) s) l))]
      [(from e in l c ... select s)
        (identifier? #'e)
        (syntax-case #'(c ...) (where orderby asc desc in)
          [(where p rest ...)
            (if (e? #'e #'p)
              #'(from e in l
                 rest ...
                 select s)
              #'(from e in (filter (lambda (e) p) l)
                 rest ...
                 select s))]
          [(from e* in l* rest ...)
            #'(flatten
                (from e in l
                 select
                  (from e* in l*
                   rest ...
                   select s)))]
          [(orderby p asc rest ...)
            #'(from e in
                 (sort #t l (lambda (e) p) (lambda (e) p))
               rest ...
               select s)]
          [(orderby p desc rest ...)
            #'(from e in
                 (sort #f l (lambda (e) p) (lambda (e) p))
               rest ...
               select s)]
          [(orderby p rest ...)
            #'(from e in l
               orderby p asc
               rest ...
               select s)]
      )])))

Usage (shows nested ‘from x in y’ equivalence):

(define al ‘((a 4) (d 3) (a 2) (c 9) (a 10)))

(write
  (
  from e in al
  orderby (cadr e)
  from x in e
  where (eq? x ‘a)
  select e
  ))
(newline) ;=> ((a 2) (a 4) (a 10))

(write
  (flatten
  (
  from e in al
  orderby (cadr e)
  select
    (from x in e
     where (eq? x ‘a)
     select e)
  )))
(newline) ;=> ((a 2) (a 4) (a 10))

Added the nested ‘from x in y’ construct. Added symbol comparison.

(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)
    (define (e? e o)
      (eq? (syntax->datum e) (syntax->datum o)))
    (syntax-case x (in select)
      [(from e in l select sel)
        (identifier? #'e)
        (if (e? #'e #'sel)
          #'l
          #'(map (lambda (e) sel) l))]
      [(from e in l c ... select sel)
        (identifier? #'e)
        (syntax-case #'(c ...) (where orderby asc desc)
          [(where p rest ...)
            (if (e? #'e #'p)
              #'(from e in l
                 rest ...
                 select sel)
              #'(from e in (filter (lambda (e) p) l)
                 rest ...
                 select sel))]
          [(from e* in l* rest ...)
            #'(from e* in
                 (flatten (from e in l select l*))
               rest ...
               select sel)]
          [(orderby p asc rest ...)
            #'(from e in
                 (sort #t l (lambda (e) p) (lambda (e) p))
               rest ...
               select sel)]
          [(orderby p desc rest ...)
            #'(from e in
                 (sort #f l (lambda (e) p) (lambda (e) p))
               rest ...
               select sel)]
          [(orderby p rest ...)
            #'(from e in l
               orderby p asc
               rest ...
               select sel)]
      )])))

Usage for nested ‘from x in y’:

(define al ‘((a 2) (b 3) (d 4) (c 1)))

(write
  (
  from e in al
  from x in e
  where (symbol? x)
  orderby x desc
  select x
  ))
(newline) ;=> (d c b a)

UPDATE:
The above version has a problem/limitation with the nested ‘from x in y’ as the ‘e’ variable goes out of scope, and cannot be used further on. I will try to address that next.

Well this is proving to be an interesting exercise I think most would agree the new solution provides much better extensibility.

(import (rnrs))

(define (compare asc? a b)
  (if asc?
    (cond
      [(and (number? a) (number? b)) (< a b)]
      [(and (char? a) (char? b)) (char<? a b)]
      [(and (string? a) (string? b)) (string<? a b)]
      [else (error 'compare "not supported" a b)])
    (cond
      [(and (number? a) (number? b)) (> a b)]
      [(and (char? a) (char? b)) (char>? a b)]
      [(and (string? a) (string? b)) (string>? a b)]
      [else (error 'compare "not supported" a b)])))

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

(define-syntax from
  (lambda (x)
    (define (e? e o)
      (eq? (syntax->datum e) (syntax->datum o)))
    (syntax-case x (in select)
      [(from e in l select sel)
        (identifier? #'e)
        (if (e? #'e #'sel)
          #'l
          #'(map (lambda (e) sel) l))]
      [(from e in l c ... select sel)
        (syntax-case #'(c ...) (where orderby asc desc)
          [(where p rest ...)
            (if (e? #'e #'p)
              #'(from e in l
                 rest ...
                 select sel)
              #'(from e in (filter (lambda (e) p) l)
                 rest ...
                 select sel))]
          [(orderby p asc rest ...)
            #'(from e in
                 (sort #t l (lambda (e) p) (lambda (e) p))
               rest ...
               select sel)]
          [(orderby p desc rest ...)
            #'(from e in
                 (sort #f l (lambda (e) p) (lambda (e) p))
               rest ...
               select sel)]
          [(orderby p rest ...)
            #'(from e in l
               orderby p asc
               rest ...
               select sel)]
      )])))

(import (rnrs))

(define (compare asc? a b)
  (if asc?
    (cond
      [(and (number? a) (number? b)) (< a b)]
      [(and (char? a) (char? b)) (char<? a b)]
      [(and (string? a) (string? b)) (string<? a b)]
      [else (error 'compare "not supported" a b)])
    (cond
      [(and (number? a) (number? b)) (> a b)]
      [(and (char? a) (char? b)) (char>? a b)]
      [(and (string? a) (string? b)) (string>? a b)]
      [else (error 'compare "not supported" a b)])))

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

(define-syntax from
  (lambda (x)
    (define (e? e o)
      (