60 lines
1.2 KiB
Scheme
60 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
|