From b7c2892b136d0c28cf49fadb861fd212b00e1884 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 5 Apr 2016 18:11:47 -0700 Subject: [PATCH] Add get-if-available operation to metadata. Also add better error message to get operation. --- src/runtime/global.scm | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/src/runtime/global.scm b/src/runtime/global.scm index 7d84dc016..c1616ddf7 100644 --- a/src/runtime/global.scm +++ b/src/runtime/global.scm @@ -494,10 +494,16 @@ USA. (if (assv key alist) #t #f)) (define (get key) + (let ((metadata (get-if-available key (default-object)))) + (if (default-object? metadata) + (error "Object has no associated metadata:" key)) + metadata)) + + (define (get-if-available key default-value) (let ((p (assv key alist))) - (if (not p) - (error "Unregistered key:" key)) - (cdr p))) + (if p + (cdr p) + default-value))) (define (put! key metadata) (let ((p (assv key alist))) @@ -526,12 +532,13 @@ USA. (case operator ((has?) has?) ((get) get) + ((get-if-available) get-if-available) ((put!) put!) ((delete!) delete!) ((get-alist) get-alist) ((put-alist!) put-alist!) (else (error "Unknown operator:" operator)))))) - + (define (make-hashed-metadata-table) (let ((table (make-key-weak-eqv-hash-table))) @@ -539,7 +546,13 @@ USA. (hash-table-exists? table key)) (define (get key) - (hash-table-ref table key)) + (let ((metadata (get-if-available key (default-object)))) + (if (default-object? metadata) + (error "Object has no associated metadata:" key)) + metadata)) + + (define (get-if-available key default-value) + (hash-table-ref/default table key default-value)) (define (put! key metadata) (hash-table-set! table key metadata)) @@ -559,6 +572,7 @@ USA. (case operator ((has?) has?) ((get) get) + ((get-if-available) get-if-available) ((put!) put!) ((delete!) delete!) ((get-alist) get-alist) -- 2.25.1