;;;; list-utils.basic.scm  -*- scheme -*-
;;;; Kon Lovett, Aug '23
;;;; Kon Lovett, Jul '07

(module (list-utils basic)

(;export
  list-count
  length=0? length=1? length=2? length>1?
  ensure-flat-list list-flatten
  ensure-list
  not-null?
  pair-ref
  list-set!
  list-copy*
  make-list/as)

(import scheme)
(import (chicken base))
(import (chicken type))
(import (only (srfi 1) count make-list append! take drop every concatenate))
(import (check-errors sys))

(: list-count (('a #!rest * -> *) (list-of 'a) #!rest list --> fixnum))

(: ensure-flat-list (* -> list))
(: list-flatten (list -> list))

(: pair-ref (list fixnum --> list))

(: list-set! (list fixnum * -> void))
(: list-copy* (list #!optional fixnum fixnum * --> list))

(: make-list/as ('a --> (#!optional (or fixnum list) -> (list-of 'a))))

;;;

; helps w/ readable code
;
(define list-count count)

;; List of length = 0?

(define-syntax length=0?
  (syntax-rules ()
    ((length=0? ?obj)
      (null? ?obj) ) ) )

;; List of length = 1?

(define-syntax length=1?
  (syntax-rules (_obj)
    ((length=1? ?obj)
      (let ((_obj ?obj))
        (and (pair? _obj)
             (null? (cdr _obj))) ) ) ) )

;; List of length > 1?

(define-syntax length>1?
  (syntax-rules (_obj)
    ((length>1? ?obj)
      (let ((_obj ?obj))
        (and (pair? _obj)
             (pair? (cdr _obj))) ) ) ) )

;; List of length = 2?

(define-syntax length=2?
  (syntax-rules (_obj)
    ((length=2? ?obj)
      (let ((_obj ?obj))
        (and (length>1? _obj)
             (null? (cddr _obj))) ) ) ) )

;; Returns a list

(define (ensure-flat-list x)
  (cond ((null? x) x)
        ((pair? x) (list-flatten x))
        (else (list x)) ) )

(define (list-flatten ls)
  (concatenate (map ensure-flat-list ls)) )

;; Returns a list

(define-syntax ensure-list
  (syntax-rules (_obj)
    ((ensure-list ?obj)
      (let ((_obj ?obj))
        (if (list? _obj) _obj
            (list _obj)) ) ) ) )

;; Returns #f if given list is empty and the list itself otherwise
;; It is intended for emulation of MIT-style empty list treatment
;; (not-null? <list>) may be considered as a counterpart to MIT-style <list>

(define-syntax not-null?
  (syntax-rules (_obj)
    ((not-null? ?obj)
      (let ((_obj ?obj))
        (and (not (null? _obj))
             _obj) ) ) ) )

(define pair-ref drop)

(define (list-set! ls idx val)
  (let ((ls (pair-ref ls idx)))
    (if (null? ls) (error 'list-set! "index out-of-bounds" idx ls)
        (set-car! ls val) ) ) )

(define (list-copy* ls #!optional (start 0) (end (length ls)) (fill (void)))
  (unless (<= start end)
    (error 'list-copy* "start > end" start end) )
  (let* ((tot (- end start))
         (end (min end (length ls)))
         (len (- end start))
         (ls (take (drop ls start) len)) )
    ;(assert (<= tot len))
    (append! ls (make-list (- tot len) fill)) ) )

(define (make-list/as df)
  (case-lambda
    (() df)
    ((n)
      (cond ((fixnum? n)
              (make-list n df))
            ((list? n)
              (make-list (length n) df))
            (else
              (error 'make-list/as
                     "invalid length specification" n df)) ) ) ) )

) ;module (list-utils basic)