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

(declare
  (always-bound ##sys#arbitrary-unbound-symbol)
  (bound-to-procedure ##sys#slot))

(module symbol-value-utils

(;export
  unbound-value unbound-value? unbound?
  symbol-value
  unspecified-value unspecified-value? unspecified?)

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

;; Unbound

(define-syntax unbound-value
	(syntax-rules ()
		((unbound-value)
			(##sys#slot '##sys#arbitrary-unbound-symbol 0) ) ) )

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

(define-syntax unbound?
	(syntax-rules ()
		((unbound? ?sym)
			(unbound-value? (##sys#slot ?sym 0)) ) ) )

(define-syntax symbol-value
	(syntax-rules ()
    ;
    ((symbol-value ?sym ?def)
      (let ((val (##sys#slot ?sym 0)))
        (if (unbound-value? val) ?def val) ) )
    ;
    ((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