Implement non-empty-list?.

diff --git a/src/runtime/list.scm b/src/runtime/list.scm
index cee530d59566ff66dc74e897b1ba537c66f11710..7fa192d84e3691dfe36a4a9719248f98493210b6 100644 (file)
--- a/src/runtime/list.scm
+++ b/src/runtime/list.scm
@@ -174,6 +174,10 @@ USA.
                  #f)))
        #f)))
 
+(define (non-empty-list? object)
+  (and (pair? object)
+       (list? (cdr object))))
+
 (define-guarantee pair "pair")
 (define-guarantee list "list")
 (define-guarantee dotted-list "improper list")

diff --git a/src/runtime/predicate-metadata.scm b/src/runtime/predicate-metadata.scm
index 7db9532fb0204d1380f43c4e3d83ee4b5bca55e2..b68a421d4f8f25d88f8b2bb3a34ebea1cd4bccb7 100644 (file)
--- a/src/runtime/predicate-metadata.scm
+++ b/src/runtime/predicate-metadata.scm
@@ -264,6 +264,7 @@ USA.
    (register-predicate! keyword-list? 'keyword-list '<= list?)
    (register-predicate! list-of-unique-symbols? 'list-of-unique-symbols
                        '<= list?)
+   (register-predicate! non-empty-list? 'non-empty-list '<= (list list? pair?))
    (register-predicate! unique-keyword-list? 'unique-keyword-list
                        '<= keyword-list?)
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index ef1e73820a0e433264c2d00f90358ae598fc77f7..cd23dfe0cdc9b27b472690f271b9713d644aeea6 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2738,6 +2738,7 @@ USA.
          memq
          memv
          ninth
+         non-empty-list?
          not-pair?                     ;SRFI-1
          null-list?                    ;SRFI-1
          null?