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.
Posted in Default, IronScheme