You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
48 lines
1.6 KiB
48 lines
1.6 KiB
(define-module (tk listlogic)
|
|
#:export (flatten
|
|
lp&
|
|
l&
|
|
)
|
|
#:duplicates (warn-override-core warn ))
|
|
|
|
(define (flatten-helper lst acc stk)
|
|
(cond ((null? lst)
|
|
(if (null? stk) (reverse acc)
|
|
(flatten-helper (car stk) acc (cdr stk))))
|
|
((pair? (car lst))
|
|
(flatten-helper (car lst) acc (cons (cdr lst) stk)))
|
|
(else
|
|
(flatten-helper (cdr lst) (cons (car lst) acc) stk))))
|
|
|
|
;; Flatten an input list, that is: if any entry in the list is itself a list
|
|
;;the entries in that list are 'unwrapped'. This occurs recursively.
|
|
(define (flatten lst) (flatten-helper lst '() '()))
|
|
|
|
;; A flat cons. Normal cons returns a list with a nested association in the
|
|
;;car position if x is a list, this function eliminates that assocation,
|
|
;;recursively "flattening" x and combining it's cdr with y.
|
|
(define (fcons x y)
|
|
(cond ((pair? x)
|
|
(fcons (car x) (fcons (cdr x) y)))
|
|
((null? x)
|
|
y)
|
|
(else
|
|
(cons x y))))
|
|
|
|
;; Evaluates (p (car ls1) (car ls2)) and accumulate into a return list as long
|
|
;;as that evauluation results in #t.
|
|
(define (lp& p ls1 ls2)
|
|
(let loop ((ls1 ls1) (ls2 ls2))
|
|
(cond ((not (and (pair? ls1) (pair? ls2)))
|
|
'())
|
|
((p (car ls1) (car ls2))
|
|
(cons (car ls1) (loop (cdr ls1) (cdr ls2))))
|
|
(else '())
|
|
)))
|
|
|
|
;; Collect entries from the beginning of the given lists as long as those
|
|
;;entries are equivalent according to (eqv?)
|
|
(define (l& ls1 ls2)
|
|
(cond ((eqv? ls1 ls2) ls1)
|
|
(else (lp& eqv? ls1 ls2))))
|