[API] gnc:list-flatten flattens lists recursively

and is a schemey algorithm rather than a report algorithm, so, belongs
centrally.
pull/583/head
Christopher Lam 7 years ago
parent 7a662272b3
commit 0511ce723e

@ -317,17 +317,6 @@
(gnc-budget-get-account-period-actual-value budget acct period))
periodlist)))
(define (flatten lst)
(reverse!
(let loop ((lst lst) (result '()))
(if (null? lst)
result
(let ((elt (car lst))
(rest (cdr lst)))
(if (pair? elt)
(loop rest (append (loop elt '()) result))
(loop rest (cons elt result))))))))
;; Adds a line to the budget report.
;;
;; Parameters:
@ -342,7 +331,7 @@
column-list exchange-fn)
(let* ((comm (xaccAccountGetCommodity acct))
(reverse-balance? (gnc-reverse-balance acct))
(allperiods (filter number? (flatten column-list)))
(allperiods (filter number? (gnc:list-flatten column-list)))
(total-periods (if accumulate?
(iota (1+ (apply max allperiods)))
allperiods))

@ -10,6 +10,7 @@
(test-traverse-vec)
(test-substring-replace)
(test-sort-and-delete-duplicates)
(test-gnc:list-flatten)
(test-begin "test-libgnucash-scm-utilities.scm"))
(define (test-traverse-vec)
@ -87,3 +88,14 @@
'(1 2 3)
(sort-and-delete-duplicates '(3 1 2) <))
(test-end "sort-and-delete-duplicates"))
(define (test-gnc:list-flatten)
(test-equal "gnc:list-flatten null"
'()
(gnc:list-flatten '()))
(test-equal "gnc:list-flatten noop"
'(1 2 3)
(gnc:list-flatten '(1 2 3)))
(test-equal "gnc:list-flatten deep"
'(1 2 3 4 5 6)
(gnc:list-flatten '(1 (2) (() () (((((3))) ())) 4 () ((5) (6)))))))

@ -47,6 +47,7 @@
(export gnc:debug)
(export addto!)
(export sort-and-delete-duplicates)
(export gnc:list-flatten)
;; Do this stuff very early -- but other than that, don't add any
;; executable code until the end of the file if you can help it.
@ -191,6 +192,17 @@
(define (kons a b) (if (and (pair? b) (= a (car b))) b (cons a b)))
(reverse (fold kons '() (sort lst <))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; flattens an arbitrary deep nested list into simple list. this is
;; probably the most efficient algorithm available. '(1 2 (3 4)) -->
;; '(1 2 3 4)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:list-flatten . lst)
(reverse
(let lp ((e lst) (accum '()))
(if (list? e)
(fold lp accum e)
(cons e accum)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; compatibility hack for fixing guile-2.0 string handling. this code

Loading…
Cancel
Save