From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 6 Apr 2016 01:11:47 +0000 (-0700)
Subject: Add get-if-available operation to metadata.
X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~62
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b7c2892b136d0c28cf49fadb861fd212b00e1884;p=mit-scheme.git

Add get-if-available operation to metadata.

Also add better error message to get operation.
---

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)