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

;; Issues
;;
;; - Move folds into operations

(module (list-utils basic)

(;export
  list-count
  length=0? length=1? length=2? length>1?
  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! reverse! take drop every))
(import (check-errors sys))

;per srfi-1.types
(: list-count (('a #!rest * -> . *) list #!rest * -> . *))

;per srfi-1.types
(: pair-ref ((list-of 'a) fixnum -> (list-of 'a)))

(: 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-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 (not (null? ls)) (set-car! ls val)
        (error 'list-set! "index out-of-bounds" idx ls) ) ) )

;; Returns a list

(define (list-copy* ls #!optional (start 0) (end (length ls)) (fill (void)))
  (unless (<= 0 start (length ls))
    (error 'list-copy* "start must be within list bounds" start (length ls)) )
  (unless (<= start end)
    (error 'list-copy* "start must be on or before 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)) ) )

;NOTE dubious utility
(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)