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

Your response: