/usr/share/scsh-0.6/srfi/srfi-2.scm is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | ; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; The reference implementation is written in some weird Scheme variant.
; This is an attempt to produce the same result using SYNTAX-RULES.
; I found the both the specification and the implementation unhelpful.
; For example, one would think that (AND-LET* ()) -> #T by analogy with
; (AND) -> #T. The specification doesn't say.
;
; The following behaves correctly on the test cases at the end of the
; reference implementation, except that it doesn't catch the three syntax
; errors. There is no way for SYNTAX-RULES to distinguish between a
; constant and a variable, and no easy way to check if a variable is
; being used twice in the same AND-LET* (and why is that an error? LET*
; allows it).
(define-syntax and-let*
(syntax-rules ()
; No body - behave like AND.
((and-let* ())
#t)
((and-let* ((var exp)))
exp)
((and-let* ((exp)))
exp)
((and-let* (var))
var)
; Have body - behave like LET* but check for #F values.
; No clauses so just use the body.
((and-let* () . body)
(begin . body))
; (VAR VAL) clause - bind the variable and check for #F.
((and-let* ((var val) more ...) . body)
(let ((var val))
(if var
(and-let* (more ...) . body)
#f)))
; Error check to catch illegal (A B ...) clauses.
((and-let* ((exp junk . more-junk) more ...) . body)
(error "syntax error"
'(and-let* ((exp junk . more-junk) more ...) . body)))
; (EXP) and VAR - just check the value for #F.
; There is no way for us to check that VAR is an identifier and not a
; constant
((and-let* ((exp) more ...) . body)
(if exp
(and-let* (more ...) . body)
#f))
((and-let* (var more ...) . body)
(if var
(and-let* (more ...) . body)
#f))))
;(define-syntax expect
; (syntax-rules ()
; ((expect a b)
; (if (not (equal? a b))
; (error "test failed" 'a b)))))
;
;(expect (and-let* () 1) 1)
;(expect (and-let* () 1 2) 2)
;(expect (and-let* () ) #t)
;
;(expect (let ((x #f)) (and-let* (x))) #f)
;(expect (let ((x 1)) (and-let* (x))) 1)
;(expect (and-let* ((x #f)) ) #f)
;(expect (and-let* ((x 1)) ) 1)
;;(must-be-a-syntax-error (and-let* ( #f (x 1))) )
;(expect (and-let* ( (#f) (x 1)) ) #f)
;;(must-be-a-syntax-error (and-let* (2 (x 1))) )
;(expect (and-let* ( (2) (x 1)) ) 1)
;(expect (and-let* ( (x 1) (2)) ) 2)
;(expect (let ((x #f)) (and-let* (x) x)) #f)
;(expect (let ((x "")) (and-let* (x) x)) "")
;(expect (let ((x "")) (and-let* (x) )) "")
;(expect (let ((x 1)) (and-let* (x) (+ x 1))) 2)
;(expect (let ((x #f)) (and-let* (x) (+ x 1))) #f)
;(expect (let ((x 1)) (and-let* (((positive? x))) (+ x 1))) 2)
;(expect (let ((x 1)) (and-let* (((positive? x))) )) #t)
;(expect (let ((x 0)) (and-let* (((positive? x))) (+ x 1))) #f)
;(expect (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1))) (+ x 1))) 3)
;;(must-be-a-syntax-error
;; (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))
;;)
;
;(expect (let ((x 1)) (and-let* (x ((positive? x))) (+ x 1))) 2)
;(expect (let ((x 1)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))) 2)
;(expect (let ((x 0)) (and-let* (x ((positive? x))) (+ x 1))) #f)
;(expect (let ((x #f)) (and-let* (x ((positive? x))) (+ x 1))) #f)
;(expect (let ((x #f)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))) #f)
;
;(expect (let ((x 1)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) #f)
;(expect (let ((x 0)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) #f)
;(expect (let ((x #f)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) #f)
;(expect (let ((x 3)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))) 3/2)
|