From f24b9140d6f74804d5599ec225717d38ca443813 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:26 -0800
Subject: Import Upstream version 2c0

---
 comlist.scm | 30 ++++++++++++++++++++++--------
 1 file changed, 22 insertions(+), 8 deletions(-)

(limited to 'comlist.scm')

diff --git a/comlist.scm b/comlist.scm
index 2c243fe..1751c7f 100644
--- a/comlist.scm
+++ b/comlist.scm
@@ -137,6 +137,9 @@
 		   (rev-it rev-it rev-cdr))
 		  ((begin (set-cdr! rev-it reved) (null? rev-cdr)) rev-it)))))
 
+(define (comlist:last lst n)
+  (comlist:nthcdr (- (length lst) n) lst))
+
 (define (comlist:butlast lst n)
   (letrec ((l (- (length lst) n))
 	   (bl (lambda (lst n)
@@ -151,8 +154,15 @@
 (define (comlist:nthcdr n lst)
   (if (zero? n) lst (comlist:nthcdr (+ -1 n) (cdr lst))))
 
-(define (comlist:last lst n)
-  (comlist:nthcdr (- (length lst) n) lst))
+(define (comlist:butnthcdr n lst)
+  (letrec ((bn (lambda (lst n)
+		 (cond ((null? lst) lst)
+		       ((positive? n)
+			(cons (car lst) (bn (cdr lst) (+ -1 n))))
+		       (else '())))))
+    (bn lst (if (negative? n)
+		(slib:error "negative argument to butnthcdr" n)
+		n))))
 
 ;;;; CONDITIONALS
 
@@ -211,7 +221,7 @@
    (else
     (case obj-type
       ((char)   (case result-type
-		  ((number) (char->integer obj))
+		  ((number integer) (char->integer obj))
 		  ((string) (string obj))
 		  ((symbol) (string->symbol (string obj)))
 		  ((list)   (list obj))
@@ -220,6 +230,7 @@
       ((number) (case result-type
 		  ((char)   (integer->char obj))
 		  ((atom)   obj)
+		  ((integer) obj)
 		  ((string) (number->string obj))
 		  ((symbol) (string->symbol (number->string obj)))
 		  ((list)   (string->list (number->string obj)))
@@ -229,14 +240,14 @@
 		  ((char)   (if (= 1 (string-length obj)) (string-ref obj 0)
 				(err)))
 		  ((atom)   (or (string->number obj) (string->symbol obj)))
-		  ((number) (or (string->number obj) (err)))
+		  ((number integer) (or (string->number obj) (err)))
 		  ((symbol) (string->symbol obj))
 		  ((list)   (string->list obj))
 		  ((vector) (list->vector (string->list obj)))
 		  (else     (err))))
       ((symbol) (case result-type
 		  ((char)   (coerce (symbol->string obj) 'char))
-		  ((number) (coerce (symbol->string obj) 'number))
+		  ((number integer) (coerce (symbol->string obj) 'number))
 		  ((string) (symbol->string obj))
 		  ((atom)   obj)
 		  ((list)   (string->list (symbol->string obj)))
@@ -247,7 +258,8 @@
 				     (char? (car obj)))
 				(car obj)
 				(err)))
-		  ((number) (or (string->number (list->string obj)) (err)))
+		  ((number integer)
+		   (or (string->number (list->string obj)) (err)))
 		  ((string) (list->string obj))
 		  ((symbol) (string->symbol (list->string obj)))
 		  ((vector) (list->vector obj))
@@ -257,7 +269,8 @@
 				     (char? (vector-ref obj 0)))
 				(vector-ref obj 0)
 				(err)))
-		  ((number) (or (string->number (coerce obj string)) (err)))
+		  ((number integer)
+		   (or (string->number (coerce obj string)) (err)))
 		  ((string) (list->string (vector->list obj)))
 		  ((symbol) (string->symbol (coerce obj string)))
 		  ((list)   (list->vector obj))
@@ -310,9 +323,10 @@
 (define remove-if-not comlist:remove-if-not)
 (define nconc comlist:nconc)
 (define nreverse comlist:nreverse)
+(define last comlist:last)
 (define butlast comlist:butlast)
 (define nthcdr comlist:nthcdr)
-(define last comlist:last)
+(define butnthcdr comlist:butnthcdr)
 (define and? comlist:and?)
 (define or? comlist:or?)
 (define has-duplicates? comlist:has-duplicates?)
-- 
cgit v1.2.3