From 27ec11474b41d2a68e621106ce0d3d8757c9b662 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 23 Jul 2016 08:17:49 +0200 Subject: [PATCH] scm.mes: add last-pair. --- scm.mes | 6 ++++++ test.mes | 14 ++++++++++++-- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/scm.mes b/scm.mes index 9f8ce9b3..0382dfb4 100755 --- a/scm.mes +++ b/scm.mes @@ -198,3 +198,9 @@ (let ((value (number->string counter))) (set! counter (+ counter 1)) (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))))) diff --git a/test.mes b/test.mes index f4431651..63b5e076 100644 --- a/test.mes +++ b/test.mes @@ -33,8 +33,9 @@ (#t (display ": fail") (newline) (set! fail (+ fail 1))))))) (define (guile?) (defined? 'gc)) -(if (guile?) - (module-define! (current-module) 'builtin? (lambda (. x) #t))) +(when (guile?) + (module-define! (current-module) 'builtin? (lambda (. x) #t)) + (use-modules (srfi srfi-1))) (define (seq? a b) (or (eq? a b) @@ -224,6 +225,15 @@ ((foo))) #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) (display "passed: ") (display (car (result))) (newline) (display "failed: ") (display (cadr (result))) (newline)