From: Joe Marshall <eval.apply@gmail.com>
Date: Fri, 25 Feb 2011 20:58:30 +0000 (-0800)
Subject: Export some predicates.
X-Git-Tag: 20110426-Gtk~2^2~34^2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=93c7c6ba3e4b461750e01c56378e30f70cda59a7;p=mit-scheme.git

Export some predicates.
---

diff --git a/src/runtime/lambda-list.scm b/src/runtime/lambda-list.scm
index d58e45ee7..8a8a76e55 100644
--- a/src/runtime/lambda-list.scm
+++ b/src/runtime/lambda-list.scm
@@ -123,6 +123,26 @@ USA.
 (define lambda-tag:rest (object-new-type (ucode-type constant) 4))
 (define lambda-tag:key (object-new-type (ucode-type constant) 5))
 (define lambda-tag:aux (object-new-type (ucode-type constant) 8))
+
+(define (lambda-tag? object)
+  (or (eq? object lambda-tag:aux)
+      (eq? object lambda-tag:key)
+      (eq? object lambda-tag:optional)
+      (eq? object lambda-tag:rest)
+
+      ;; The following ones are called `lambda-tag', but they are
+      ;; semantically quite different from lambda list keywords.
+      ;; This should be fixed some day.
+
+      ;; From lambda.scm
+      (eq? object lambda-tag:internal-lambda)
+      (eq? object lambda-tag:internal-lexpr)
+
+      ;; From syntax-output.scm
+      (eq? object lambda-tag:fluid-let)
+      (eq? object lambda-tag:let)
+      (eq? object lambda-tag:unnamed)
+      ))
 
 (define (parse-mit-lambda-list lambda-list)
   (let ((required (list '()))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 008a5b9ba..3537ad6fd 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2104,6 +2104,7 @@ USA.
 	  hash-table-fold
 	  hash-table-merge!
 	  hash-table-ref
+	  hash-table-type?
 	  hash-table-update!
 	  hash-table/clean!
 	  hash-table/clear!
@@ -2415,6 +2416,9 @@ USA.
   (export (runtime compiler-info)
 	  lambda-tag:internal-lambda
 	  lambda-tag:internal-lexpr)
+  (export (runtime lambda-list)
+	  lambda-tag:internal-lambda
+	  lambda-tag:internal-lexpr)
   (initialization (initialize-package!)))
 
 (define-package (runtime list)
@@ -2619,6 +2623,7 @@ USA.
 	  lambda-tag:key
 	  lambda-tag:optional
 	  lambda-tag:rest
+	  lambda-tag?
 	  map-mit-lambda-list
 	  map-r4rs-lambda-list
 	  mit-lambda-list?
@@ -3797,6 +3802,7 @@ USA.
 	  graphics-set-drawing-mode
 	  graphics-set-line-style
 	  graphics-type
+	  (graphics-type? graphics-device-type?)
 	  graphics-type-available?
 	  graphics-type-name
 	  graphics-type-properties