>From bb15677cada6f0f954f88ea1a314c1c291387ab2 Mon Sep 17 00:00:00 2001 From: LemonBoy Date: Sun, 12 Nov 2017 19:04:21 +0100 Subject: [PATCH] Make and-let* behave as specified in SRFI-2 When the body is missing the construction should return the last expression that's been evaluated or the last variable that's been bound. If there are no bindings and no body then #t is returned, like (and) does. Make sure the non-braced expressions refer to a variable and throw a syntax error otherwise. --- chicken-syntax.scm | 17 ++++++++++++----- tests/syntax-tests.scm | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 5 deletions(-) diff --git a/chicken-syntax.scm b/chicken-syntax.scm index 48a84726..d423371a 100644 --- a/chicken-syntax.scm +++ b/chicken-syntax.scm @@ -688,18 +688,25 @@ (##sys#check-syntax 'and-let* form '(_ #(_ 0) . _)) (let ((bindings (cadr form)) (body (cddr form))) - (let fold ([bs bindings]) + (let fold ([bs bindings] [last #t]) (if (null? bs) - `(##core#begin ,@body) + `(##core#begin ,last . ,body) (let ([b (car bs)] [bs2 (cdr bs)] ) - (cond [(not (pair? b)) `(##core#if ,b ,(fold bs2) #f)] - [(null? (cdr b)) `(##core#if ,(car b) ,(fold bs2) #f)] + (cond [(not (pair? b)) + (##sys#check-syntax 'and-let* b 'symbol) + (let ((var (r (gensym)))) + `(##core#let ((,var ,b)) + (##core#if ,var ,(fold bs2 var) #f)))] + [(null? (cdr b)) + (let ((var (r (gensym)))) + `(##core#let ((,var ,(car b))) + (##core#if ,var ,(fold bs2 var) #f)))] [else (##sys#check-syntax 'and-let* b '(symbol _)) (let ((var (car b))) `(##core#let ((,var ,(cadr b))) - (##core#if ,var ,(fold bs2) #f) ) ) ] ) ) ) ) ) ) ) ) + (##core#if ,var ,(fold bs2 var) #f)))])))))))) diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm index de754e95..9e750b17 100644 --- a/tests/syntax-tests.scm +++ b/tests/syntax-tests.scm @@ -914,6 +914,42 @@ (t 'foo (and-let* (((= 4 4)) (a 'foo)) a)) (t #f (and-let* ((a #f) ((error "not reached 1"))) (error "not reached 2"))) +(t (and-let* () 1) 1) +(t (and-let* () 1 2) 2) +(t (and-let* () ) #t) + +(t (let ((x #f)) (and-let* (x))) #f) +(t (let ((x 1)) (and-let* (x))) 1) +(t (and-let* ((x #f)) ) #f) +(t (and-let* ((x 1)) ) 1) +(f (eval '(and-let* ( #f (x 1))) )) +(t (and-let* ( (#f) (x 1)) ) #f) +(f (eval '(and-let* (2 (x 1))) )) +(t (and-let* ( (2) (x 1)) ) 1) +(t (and-let* ( (x 1) (2)) ) 2) +(t (let ((x #f)) (and-let* (x) x)) #f) +(t (let ((x "")) (and-let* (x) x)) "") +(t (let ((x "")) (and-let* (x) )) "") +(t (let ((x 1)) (and-let* (x) (+ x 1))) 2) +(t (let ((x #f)) (and-let* (x) (+ x 1))) #f) +(t (let ((x 1)) (and-let* (((positive? x))) (+ x 1))) 2) +(t (let ((x 1)) (and-let* (((positive? x))) )) #t) +(t (let ((x 0)) (and-let* (((positive? x))) (+ x 1))) #f) +(t (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1))) (+ x 1))) 3) +; The uniqueness of the bindings isn't enforced +(t (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1))) 4) + +(t (let ((x 1)) (and-let* (x ((positive? x))) (+ x 1))) 2) +(t (let ((x 1)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))) 2) +(t (let ((x 0)) (and-let* (x ((positive? x))) (+ x 1))) #f) +(t (let ((x #f)) (and-let* (x ((positive? x))) (+ x 1))) #f) +(t (let ((x #f)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))) #f) + +(t (let ((x 1)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) #f) +(t (let ((x 0)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) #f) +(t (let ((x #f)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) #f) +(t (let ((x 3)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) 3/2) + ;;; SRFI-26 ;; Cut -- 2.11.0