(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)])))
(define (sort asc? l a b)
(list-sort
(lambda (a* b*)
(compare asc? (a a*) (b b*)))
l))
(define-syntax from
(lambda (x)
(define (e? e o)
(let ((e (syntax->datum e))
(o (syntax->datum o)))
(eq? e o))) ; fender takes care of symbol?
(syntax-case x (in select where orderby asc desc)
[(from e in l select sel)
(identifier? #'e)
(if (e? #'e #'sel)
#'l
#'(map (lambda (e) sel) l))]
[(from e in l where p select sel)
(if (e? #'e #'p)
#'(from e in l select sel)
#'(from e in (filter (lambda (e) p) l)
select sel))]
[(from e in l orderby p asc select sel)
#'(from e in
(sort #t l (lambda (e) p) (lambda (e) p))
select sel)]
[(from e in l orderby p desc select sel)
#'(from e in
(sort #f l (lambda (e) p) (lambda (e) p))
select sel)]
[(from e in l orderby o select s)
#'(from e in l orderby o asc select s)]
[(from e in l where w orderby o select s)
#'(from e in (from e in l where w select e) orderby o select s)]
[(from e in l where w orderby o asc select s)
#'(from e in (from e in l where w select e) orderby o asc select s)]
[(from e in l where w orderby o desc select s)
#'(from e in (from e in l where w select e) orderby o desc select s)]
)))
I have refactored it a bit, added some optimizations on ‘null’ transforms and added a syntax check.
Next, I am going to try to improve the permutations.
I am also not so sure about those (lambda (e) x) transforms.
Posted in Default, IronScheme