symbol-utils/symbol-value-utils.scm

59 lines
1.2 KiB
Scheme

;;;; 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
;
unspecified-value ;FIXME suspicious much?
unspecified-value? unspecified?)
(import scheme)
(import (chicken base))
(import (chicken syntax))
(import (chicken foreign))
;; Unbound
(define-syntax unbound-value?
(syntax-rules ()
((unbound-value? ?val)
(##core#inline "C_unboundvaluep" ?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