From 620b9b028ec322e4a51ae9e92f2322b69d2d22de Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 6 Jan 2017 11:52:17 -0800
Subject: [PATCH] Implement non-empty-list?.

---
 src/runtime/list.scm               | 4 ++++
 src/runtime/predicate-metadata.scm | 1 +
 src/runtime/runtime.pkg            | 1 +
 3 files changed, 6 insertions(+)

diff --git a/src/runtime/list.scm b/src/runtime/list.scm
index cee530d59..7fa192d84 100644
--- 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 7db9532fb..b68a421d4 100644
--- 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 ef1e73820..cd23dfe0c 100644
--- 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?
-- 
2.25.1