Import new table renderer.

src/template-list-expander.scm

@@ -0,0 +1,153 @@
+;;
+;; template-list-expander.scm
+;;
+;; Dynamic length lists based on simple templates with head and tail
+;; patterns.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; Permission to use, copy, modify, and/or distribute this software
+;; for any purpose with or without fee is hereby granted, provided
+;; that the above copyright notice and this permission notice appear
+;; in all copies.
+;; 
+;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(declare (unit template-list-expander))
+
+(module
+ template-list-expander
+ (
+  template-expansion-token?
+
+  expand-template-list
+
+  template-list-expander-tests!
+  )
+
+ (import scheme
+	 (chicken base)
+	 testing)
+
+ (define (template-expansion-token? token)
+   (and (symbol? token)
+	(let* ((tokenstr (symbol->string token))
+	       (tokenlen (string-length tokenstr)))
+	  (and (>= tokenlen 3)
+	       (string=? (substring tokenstr 0 3) "...")))))
+
+ (define (split-template-list temp-lst)
+   (let loop ((lst temp-lst)
+	      (rhead '()))
+     (if (null? lst)
+	 (values temp-lst '() '())
+	 (let* ((token (car lst))
+		(tokenstr (if (symbol? token)
+			      (symbol->string token)
+			      ""))
+		(tokenlen (if (symbol? token)
+			      (string-length tokenstr)
+			      0)))
+	   (cond ((and (symbol? token)
+		       (>= tokenlen 3)
+		       (string=? (substring tokenstr 0 3) "..."))
+		  (let rloop ((cnt (- tokenlen 2))
+			      (rhead2 rhead)
+			      (rrep '()))
+		    (if (= cnt 0)
+			(values (reverse rhead2)
+				rrep
+				(cdr lst))
+			(rloop (sub1 cnt)
+			       (cdr rhead2)
+			       (cons (car rhead2) rrep)))))
+		 (else
+		  (loop (cdr lst)
+			(cons token rhead))))))))
+
+ (define (repeat-list-for lst len)
+   (let loop ((cnt len)
+	      (rep lst)
+	      (res '()))
+     (if (= cnt 0)
+	 (reverse res)
+	 (loop (sub1 cnt)
+	       (if (null? (cdr rep)) lst (cdr rep))
+	       (cons (car rep) res)))))
+
+ (define (take-from-list lst cnt)
+   (let loop ((lst lst)
+	      (res '())
+	      (cnt cnt))
+     (if (= cnt 0)
+	 (reverse res)
+	 (loop (cdr lst)
+	       (cons (car lst) res)
+	       (sub1 cnt)))))
+
+ (define (expand-template-list lst len)
+   (let-values (((head rep tail) (split-template-list lst)))
+     (let ((headlen (length head))
+	   (taillen (length tail)))
+       ;;(print "----------------")
+       ;;(print "head = " head)
+       ;;(print "rep = " rep)
+       ;;(print "tail = " tail)
+       (cond
+	((= len headlen)
+	 head)
+	((< len headlen)
+	 (take-from-list head len))
+	(else
+	 (let ((head+taillen (+ headlen taillen)))
+	   (cond
+	    ((= len head+taillen)
+	     (append head tail))
+	    ((< len head+taillen)
+	     (append head (take-from-list tail (- len head+taillen))))
+	    (else
+	     (append head
+		     (repeat-list-for rep (- len head+taillen))
+		     tail)))))))))
+
+ (define (template-list-expander-tests!)
+   (run-tests
+    template-list-expander
+    (test-equal? expand-template-list
+		 (expand-template-list '() 0)
+		 '())
+    (test-equal? expand-template-list
+		 (expand-template-list '((a) ... (b)) 5)
+                 '((a) (a) (a) (a) (b)))
+    (test-equal? expand-template-list
+		 (expand-template-list '((c) (a) (d) ... (b) (e)) 9)
+                 '((c) (a) (d) (d) (d) (d) (d) (b) (e)))
+    (test-equal? expand-template-list
+		 (expand-template-list '((c) (a) (d) .... (b) (e)) 9)
+                 '((c) (a) (d) (a) (d) (a) (d) (b) (e)))
+    (test-true template-expansion-token?
+	       (template-expansion-token? '...))
+    (test-true template-expansion-token?
+	       (template-expansion-token? '....))
+    (test-false template-expansion-token?
+		(template-expansion-token? '..))
+    (test-false template-expansion-token?
+		(template-expansion-token? 'hello))
+    (test-false template-expansion-token?
+		(template-expansion-token? "hello"))
+    (test-equal? expand-template-list
+		 (expand-template-list '(a b ... c) 2)
+		 '(a c))
+    ))
+
+ )