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

(module (box values literals) ()

(import scheme)
(import (chicken base))
(import (chicken type))
(import (only (chicken read-syntax) set-parameterized-read-syntax!))
(import (only (box values) boxv box-ref))

;NOTE works w/o recourse to `define-record' for tag, so ok for tag "defining" module
(cond-expand
  ((or chicken-5.0 chicken-5.1)
    (define (set-record-printer! tag proc)
      (##sys#register-record-printer tag proc) ) )
  (else) )

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

;;;

#; ;UNUSED
(define (for-each/counter proc ls)
  (do ((i (length ls) (- i 1))
       (ls ls (cdr ls)) )
      ((zero? i) )
    (proc (car ls) i) ) )

#; ;UNUSED
(define (write-list-body ls port)
  (define (write-item obj rem)
    (write obj port)
    (unless (zero? (- rem 1)) (display #\space port)) )
  (for-each/counter write-item ls) )

(define (box-values bx) (receive (box-ref bx)))

;;;

#; ;UNUSED
(define (box-print/unreadable bx port)
  (let ((ls (box-values bx)))
	  (display "#<box " port)
	  (write-list-body ls port)
	  (display ">" port) ) )

(define-constant BOXV-SHARP #\&)

(define (box-print/parameterized bx port)
  (let* ((ls (box-values bx))
         (len (length ls))
         (single? (= 1 len))
         (len (or (and single? 0) len))
         (obj (or (and single? (car ls)) ls)) )
	  (display #\# port) (display len port) (display BOXV-SHARP port)
	  (write obj port) ) )

(define (check-read-object loc obj len)
  (define valid-read-object?
          (if (list? obj) (= len (length obj))
              (zero? len)))
  (unless valid-read-object?
    (error loc "length and value do not match" obj len) )
  obj )

(define (box-read/parameterized port len)
  (let* ((obj (check-read-object 'box-read (read port) len))
         (obj (or (and (symbol? obj) `',obj) obj)) )
    `(make-box ,obj) ) )

(set-parameterized-read-syntax! BOXV-SHARP box-read/parameterized)

;;;

(set-record-printer! boxv box-print/parameterized)

) ;module (box values literals)