Posted by: leppie | April 16, 2008

LINQ for R6RS Scheme take 7

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)
    [(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))]
      (assertion-violation 'compare "not supported" a b)]))

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

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

(define-syntax from
  (lambda (x)
      ((v '())
          (lambda (e o)
            (eq? (syntax->datum e) o)))
          (lambda (e)
            (if (= 1 (length v))
              (datum->syntax e `(list ,(syntax->datum e)))
          (lambda (e)
            (when (= 0 (length v))
              (set! v (list e)))))
          (lambda (x)
            (syntax-case x (in select)
              [(e in l select s)
                (identifier? #'e)
                  (init #'e) ; bind
                      (lambda (e)
                          (lambda (#,@v) s)
                          #,(arg #'e)))
              [(e in l c ... select s)
                (identifier? #'e)
                  (init #'e) ; bind
                  (syntax-case #'(c ...) (where let = in orderby)
                    [(where p rest ...)
                      (from* #`(e in
                            (lambda (e)
                                (lambda (#,@v) p)
                                #,(arg #'e)))
                         rest ...
                         select s))]
                    [(let y = y* rest ...)
                      (identifier? #'y)
                      (let ((v* v)
                            (a* (arg #'e)))
                        (set! v (cons #'y v))
                        (from* #`(e in
                              (lambda (e)
                                  (lambda (#,@v*)
                                    (list y* #,@v*))
                           rest ...
                           select s)))]
                    [(from e* in l* rest ...)
                          #,(from* #'(e in l
                              (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)
                                (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)))

  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)


  1. […] A post about it […]

  2. Leppie, awesome!

    You should publicize this more. At least post about it on comp.lang.scheme!

    I linked to it here:

  3. Thanks 🙂

    I think the latest version has a few more bug fixes.

    There are a bit more features I would like to add, like lazy evaluation.

    Maybe then I will subject myself to some more of comp.lang.scheme critique 🙂

Leave a Reply

Please log in using one of these methods to post your comment: Logo

You are commenting using your account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )


Connecting to %s


%d bloggers like this: