diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:26 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:26 -0800 |
commit | f24b9140d6f74804d5599ec225717d38ca443813 (patch) | |
tree | 0da952f1a5a7c0eacfc05c296766523e32c05fe2 /comlist.scm | |
parent | 8ffbc2df0fde83082610149d24e594c1cd879f4a (diff) | |
download | slib-f24b9140d6f74804d5599ec225717d38ca443813.tar.gz slib-f24b9140d6f74804d5599ec225717d38ca443813.zip |
Import Upstream version 2c0upstream/2c0
Diffstat (limited to 'comlist.scm')
-rw-r--r-- | comlist.scm | 30 |
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?) |