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.
72 lines
2.4 KiB
72 lines
2.4 KiB
(define-module (tk listlogic)
|
|
#:export (display-if-not
|
|
flatten
|
|
lp&
|
|
l&
|
|
if-some
|
|
if-some-else)
|
|
#: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))))
|
|
|
|
;; Returns the argument if it isn't #f, otherwise returns the empty list
|
|
(define-syntax if-some
|
|
(syntax-rules ()
|
|
((if-some $cond)
|
|
(if $cond $cond '()))))
|
|
|
|
;; Returns the first argument if it isn't #f, otherwise returns the second.
|
|
(define-syntax if-some-else
|
|
(syntax-rules ()
|
|
((if-some-else $cond $else)
|
|
(if $cond $cond $else))))
|
|
|
|
;; Prints the message if condition is #f, otherwise prints nothing
|
|
(define-syntax display-if-not
|
|
(syntax-rules ()
|
|
((display-if-not $cond)
|
|
(syntax-error "Must provide a string to (display-if-not)"))
|
|
((display-if-not $cond $message)
|
|
(begin (if (not $cond) (display $message))
|
|
(newline)))
|
|
((display-if-not $cond . $messages)
|
|
(display-if-not $cond (string-concatenate/shared `$messages)))))
|