summaryrefslogtreecommitdiffstats
path: root/comlist.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:26 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:26 -0800
commitf24b9140d6f74804d5599ec225717d38ca443813 (patch)
tree0da952f1a5a7c0eacfc05c296766523e32c05fe2 /comlist.scm
parent8ffbc2df0fde83082610149d24e594c1cd879f4a (diff)
downloadslib-f24b9140d6f74804d5599ec225717d38ca443813.tar.gz
slib-f24b9140d6f74804d5599ec225717d38ca443813.zip
Import Upstream version 2c0upstream/2c0
Diffstat (limited to 'comlist.scm')
-rw-r--r--comlist.scm30
1 files changed, 22 insertions, 8 deletions
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?)