artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

scm.mes: add last-pair.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-23 08:17:49 +02:00
parent 119c2fef1f
commit 27ec11474b
2 changed files with 18 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
scm.mes
View file

@ -198,3 +198,9 @@
(let ((value (number->string counter))) (let ((value (number->string counter)))
(set! counter (+ counter 1)) (set! counter (+ counter 1))
(string->symbol (string-append "g" value)))))) (string->symbol (string-append "g" value))))))
;; srfi-1
(define (last-pair lst)
(let loop ((lst lst))
(if (or (null? lst) (null? (cdr lst))) lst
(loop (cdr lst)))))

14
test.mes
View file

@ -33,8 +33,9 @@
(#t (display ": fail") (newline) (set! fail (+ fail 1))))))) (#t (display ": fail") (newline) (set! fail (+ fail 1)))))))
(define (guile?) (defined? 'gc)) (define (guile?) (defined? 'gc))
(if (guile?) (when (guile?)
(module-define! (current-module) 'builtin? (lambda (. x) #t))) (module-define! (current-module) 'builtin? (lambda (. x) #t))
(use-modules (srfi srfi-1)))
(define (seq? a b) (define (seq? a b)
(or (eq? a b) (or (eq? a b)
@ -224,6 +225,15 @@
((foo))) ((foo)))
#t)) #t))
(pass-if "last-pair " (sequal? (last-pair '(1 2 3 4)) '(4)))
(pass-if "last-pair 2" (eq? (last-pair '()) '()))
;; (pass-if "circular-list? "
;; (seq?
;; (let ((x (list 1 2 3 4)))
;; (set-cdr! (last-pair x) (cddr x))
;; (circular-list? x))
;; #t))
(newline) (newline)
(display "passed: ") (display (car (result))) (newline) (display "passed: ") (display (car (result))) (newline)
(display "failed: ") (display (cadr (result))) (newline) (display "failed: ") (display (cadr (result))) (newline)