From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Tue, 25 Apr 2017 23:55:13 +0000 (-0700)
Subject: Add option-loaded?.
X-Git-Tag: mit-scheme-pucked-9.2.12~153^2~3
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5601f2d9aaeec3e608521113e5ec6d74b20e63c3;p=mit-scheme.git

Add option-loaded?.
---

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index ca6ba622c..260614c91 100644
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -602,7 +602,7 @@ USA.
   ((environment-lookup (->environment '(ffi)) 'update-html-index) directory))
 
 (define (load-option-quietly name)
-  (if (not (name->package (list name)))
+  (if (not (option-loaded? name))
       (let ((kernel
 	     (lambda ()
 	       (parameterize* (list (cons param:suppress-loading-message? #t))
diff --git a/src/runtime/option.scm b/src/runtime/option.scm
index c19850735..18ae8f767 100644
--- a/src/runtime/option.scm
+++ b/src/runtime/option.scm
@@ -58,6 +58,9 @@ USA.
 	name
 	(find-option (*options*) (*parent*)))))
 
+(define (option-loaded? name)
+  (not (eq? #f (memq name loaded-options))))
+
 (define (define-load-option name . loaders)
   (*options* (cons (cons name loaders) (*options*)))
   unspecific)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 95bc23913..fd500ba44 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3323,6 +3323,7 @@ USA.
 	  further-load-options
 	  load-option
 	  local-load-options
+	  option-loaded?
 	  standard-load-options
 	  standard-option-loader
 	  standard-system-loader)