;;
;; 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))
    ))

 )