;;;; box values.scm  -*- Scheme -*-
;;;; Kon Lovett, Oct '24

(module (box values)

(;export
  ;
  boxv
  ;
  make-box
  box?
  box-ref box-set!
  box-arity
  box-value-ref box-value-set!)

(import scheme)
(import (chicken base))
(import (chicken syntax))
(import (chicken type))

(include-relative "box.values.types")

(: make-box (#!rest -> boxv))

(: box? (* -> boolean : boxv))

(: box-ref (boxv -> . *))
(: box-set! (boxv #!rest -> void))

(: box-arity (boxv  -> fixnum))

(: box-value-ref (boxv fixnum -> *))
(: box-value-set! (boxv fixnum * -> void))

(: box-print (boxv output-port -> void))

;;; Prelude

;(check-errors sys)

#; ;UNUSED
(define-syntax check-fixnum
  (syntax-rules ()
    ((check-fixnum ?loc ?obj)
      (begin (##sys#check-fixnum ?obj ?loc) ?obj)) ) )

#; ;UNUSED
;NOTE the module must export the tag as a binding, not all do!
(define-syntax check-structure
  (syntax-rules ()
    ((check-structure ?loc ?obj ?tag)
      (begin (##sys#check-structure ?obj ?tag ?loc) ?obj)) ) )

(define-syntax check-fixnum-in-range
  (syntax-rules ()
    ((check-fixnum-in-range ?loc ?obj ?from ?to)
      (begin (##sys#check-range ?obj ?from ?to ?loc) ?obj)) ) )

;(list-utils basic)
(define (list-set! ls idx val)
  (let loop ((ls ls) (i idx))
    (cond ((or (null? ls) (negative? i))
            (error 'list-set! "index out-of-bounds" idx ls) )
          ((zero? i)
            (set-car! ls val) )
          (else
            (loop (cdr ls) (- i 1))) ) ) )

(define (list-copy ls) (append ls '()))

;;; Box Structure

;FIXME use (inline unchecked ...)

(define-record boxv box-values)
(define-record-type boxv
  (make-box-values values)
  box?
  (values box-values box-values-set!))

#;
(define (check-box loc obj) (check-structure loc obj boxv))
(define (check-box loc obj) obj)

;;; Box Ops

;FIXME test against vector based version

(define (make-box . rest)
  (make-box-values (list-copy rest)) )

(define (box-ref bx)
  (apply values (box-values (check-box 'box-ref bx))) )

(define (box-set! bx . rest)
  (box-values-set! (check-box 'box-set! bx) (list-copy rest)) )

(define (box-arity bx)
  (length (box-values (check-box 'box-arity bx))) )

(define (box-value-ref bx idx)
  (let ((ls (box-values (check-box 'box-value-ref bx))))
    (list-ref ls (check-fixnum-in-range 'box-value-ref idx 0 (length ls))) ) )

(define (box-value-set! bx idx val)
  (let ((ls (box-values (check-box 'box-value-set! bx))))
    (list-set! ls (check-fixnum-in-range 'box-value-set! idx 0 (length ls)) val) ) )

) ;module (box values)