From 9a01271e7986bba46c8c373d0217ffac202c23ba 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. Signed-off-by: Peter Bex --- 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