Posted by: leppie | April 15, 2008

LINQ for R6RS Scheme take 6

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)
    [(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
  (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)))
      (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)
            (init #'e) ; bind
            (let ((r
                  (lambda (e)
                      (lambda #,(vars #'e) s)
                      #,(arg #'e)))
                (set! v '()) ; reset v :(
        [(from 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 #,(vars #'e) p)
                          #,(arg #'e)))
                   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
                        (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
                    (sort #,(id=? #'dir 'asc) l
                      (lambda (e)
                          (lambda #,(vars #'e) p)
                          #,(arg #'e)))
                      (lambda (e)
                          (lambda #,(vars #'e) p)
                          #,(arg #'e))))
                   rest ...
                   select s)]
              [(orderby p rest ...)
                #'(from e in l
                   orderby p asc
                   rest ...
                   select s)]


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

– 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


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: