;;;; symbol-value-utils.scm  -*- Scheme -*-
;;;; Kon Lovett, Mar '20
;;;; Kon Lovett, Jul '18

(declare
  (bound-to-procedure ##sys#slot))

(module symbol-value-utils

(;export
  ;Compiled Use Only
  unbound-value? unbound?
  symbol-value
  ;Deprecated
  unspecified-value
  unspecified-value? unspecified?)

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

(: unspecified-value (deprecated void))

;; Unbound

#| ;less exposure of shifting sands but doesn't match docu or work well

(: unbound-value? (* -> boolean))
(: unbound? (symbol -> boolean))
(: symbol-value? (symbol #!optional * -> *))

(define (unbound-value? val) (##core#inline "C_unboundvaluep" val))

(define (unbound? sym) (not (##core#inline "C_boundp" sym)))

(define (symbol-value sym #!optional def)
  #; ;local binding de-ref in expanded unit?
  (let ((val (##sys#slot sym 0)))
    (if (unbound-value? val) def val) )
  (if (unbound-value? (##sys#slot sym 0)) def
      (##sys#slot sym 0)) )
|#

(define-syntax unbound-value?
  (syntax-rules ()
    ((unbound-value? ?val)
      (##core#inline "C_unboundvaluep" ?val) ) ) )

(define-syntax unbound?
  (syntax-rules ()
    ;
    ((unbound? '?sym)
      (not (##core#inline "C_boundp" '?sym)) )
    ;just in case
    ((unbound? ?sym)
      (unbound? '?sym) ) ) )

(define-syntax symbol-value
  (syntax-rules ()
    ;just in case
    ((symbol-value '?sym ?def)
      (symbol-value ?sym ?def) )
   ;
    ((symbol-value ?sym ?def)
      #; ;local binding de-ref in expanded unit?
      (let ((val (##sys#slot ?sym 0)))
        (if (unbound-value? val) ?def val) )
      (if (unbound-value? (##sys#slot ?sym 0)) ?def
          (##sys#slot ?sym 0)) )
    ;
    ((symbol-value ?sym)
      (symbol-value ?sym #f) ) ) )

;; Undefined

(define unspecified-value void)

(define-syntax unspecified-value?
  (syntax-rules ()
    ((unspecified-value? ?val)
      (eq? (unspecified-value) ?val) ) ) )

(define-syntax unspecified?
  (syntax-rules ()
    ((unspecified? ?obj)
      (unspecified-value? ?obj) ) ) )

) ;module symbol-value-utils