Add and export CONSTANT-PROCEDURE.

diff --git a/src/runtime/global.scm b/src/runtime/global.scm
index db9b5884147b332864291619f2af8dd082742d36..32189728d50a131f4e86f504532d9cfb80a0b8d6 100644 (file)
--- a/src/runtime/global.scm
+++ b/src/runtime/global.scm
@@ -94,6 +94,7 @@ USA.
 ;;;; Potpourri
 
 (define (identity-procedure x) x)
+(define (constant-procedure k) (lambda args (declare (ignore args)) k))
 (define (null-procedure . args) args '())
 (define (false-procedure . args) args #f)
 (define (true-procedure . args) args #t)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 7e327fed70034b41bdb95f9f410d7148f5357df0..11ec4db507b2ec9f3bc5541b0298821b43114bbd 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -291,6 +291,7 @@ USA.
          cd
          cell-contents
          cell?
+         constant-procedure
          default/exit
          default/quit
          environment-link-name