From ef43239a4c52f162e74b1576a1d1518254bc7008 Mon Sep 17 00:00:00 2001 From: "michele.simionato" Date: Mon, 16 Feb 2009 07:15:21 +0000 Subject: Enhanced fold macro --- scheme/aps/list-utils.sls | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) (limited to 'scheme') diff --git a/scheme/aps/list-utils.sls b/scheme/aps/list-utils.sls index 3aa9d8b..67afdfe 100644 --- a/scheme/aps/list-utils.sls +++ b/scheme/aps/list-utils.sls @@ -123,24 +123,28 @@ (define (append-unique eq? . lists) (remove-dupl eq? (apply append lists))) ;;END - + ;;FOLD (def-syntax fold - (syntax-match (left right is in) - (sub (fold left (acc is seed) (x in lst) expr) - #'(fold-left - (lambda (acc a) (let+ (x a) expr)) - seed lst)) - (sub (fold right (acc is seed) (x in lst) expr) - #'(fold-right - (lambda (a acc) (let+ (x a) expr)) - seed lst)) + (syntax-match (left right in) + (sub (fold left (acc seed) (x in lst) (x* in lst*) ... new-acc) + (local + (with-syntax (a a* ...) (generate-temporaries #'(x x* ...))) + #'(fold-left + (lambda (acc a a* ...) (let+ (x a) (x* a*) ... new-acc)) + seed lst lst* ...))) + (sub (fold right (acc seed) (x in lst) (x* in lst*) ... new-acc) + (local + (with-syntax (a a* ...) (generate-temporaries #'(x x* ...))) + #'(fold-right + (lambda (a a* ... acc) (let+ (x a) (x* a*) ... new-acc)) + seed lst lst* ...))) )) ;;END ;;FLATTEN (define (flatten lst) - (fold right (a is '()) (x in lst) + (fold right (a '()) (x in lst) (if (list? x) (append (flatten x) a) (cons x a)))) ;;END -- cgit v1.2.1