From d46183860c1f3f10095e95023adcb79b1896ab0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 22 Mar 2019 20:11:11 +0100 Subject: Move C and Scheme code into subdirs. --- module/helpers.scm | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 module/helpers.scm (limited to 'module/helpers.scm') diff --git a/module/helpers.scm b/module/helpers.scm new file mode 100644 index 00000000..717a10d4 --- /dev/null +++ b/module/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))))) -- cgit v1.2.3