diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-02-09 03:01:53 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-02-09 03:01:53 +0100 |
commit | 7eba3f7dbcef5ecf05d6d05e1c2fbd323d7898df (patch) | |
tree | 3ba6b44d20b9f857207e55487154e8d378caea90 /helpers.scm | |
parent | Add support for full tree printing. (diff) | |
download | calp-7eba3f7dbcef5ecf05d6d05e1c2fbd323d7898df.tar.gz calp-7eba3f7dbcef5ecf05d6d05e1c2fbd323d7898df.tar.xz |
Add some more scheme bindings.
Diffstat (limited to '')
-rw-r--r-- | helpers.scm | 43 |
1 files changed, 43 insertions, 0 deletions
diff --git a/helpers.scm b/helpers.scm new file mode 100644 index 00000000..717a10d4 --- /dev/null +++ b/helpers.scm @@ -0,0 +1,43 @@ +(use-modules (srfi srfi-1) + (srfi srfi-8) ; receive + ) + +(define (nlist? l) + "Returns #t if l is a pair that is not a list." + (and (pair? l) + (not (list? l)))) + +(define (flatten tree) + "Flattens tree, should only return propper lists." + (cond ((null? tree) '()) + ((list? tree) + (if (null? (cdr tree)) + (flatten (car tree)) + (let ((ret (cons (flatten (car tree)) + (flatten (cdr tree))))) + (if (nlist? ret) + (list (car ret) (cdr ret)) + ret)))) + (else tree))) + + +(define (map-lists f lst) + "Map f over lst, if (car lst) is a list, pass the list to f. If (car list) +isn't a list, pass the rest of lst to f." + (cond ((null? lst) '()) + ((list? (car lst)) (cons (f (car lst)) + (map-lists f (cdr lst)))) + (else (f lst)))) + +(define (beautify tree) + "Takes a prefix tree and turns some characters to strings." + (define (helper branch) + (receive (head tail) + (span char? branch) + (cons (list->string head) + (beautify tail)))) + (if (or (null? tree) + (not (list? tree))) + tree + (cons (beautify (car tree)) + (map-lists helper (cdr tree))))) |