I kinda forgot that I completed the entire library.

It now supports syntactically and semantically LINQ as defined for C#. See the top of the file for getting it working on your preferred R6RS Scheme. See bottom for examples/test.

The source can be viewed here.

Exactly a week ago, my 150GB WD Raptor died, it seems like something mechanical or just physical, as Vista reports bad blocks on the drive when inserted via USB (I cant even boot with the drive plugged in). This was my system drive, so I needed to reinstall Vista, VS and all the SP’s (sigh).

Anyways, lucky I did a checkin to IronScheme the night before, and I managed to recover all the data I needed from the drive via a Linux Recovery DC (trinity recovery kit).

So development will continue as normal, just taking a bit of time to get back into it.

Cheers

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)])))

(