/usr/share/scheme48-1.9/big/mvlet.scm is in scheme48 1.9-5.
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 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees
; A version of LET and LET* which allows clauses that return multiple values.
;
; MV = multiple-value
;
; (mvlet (<clause> ...) <body>)
; (mvlet* (<clause> ...) <body>)
;
; <clause> ::= (<ids> <expression>)
; <ids> ::= <id> | (<id> ...) | (<id> ... . <id>)
;
; A clause of the form (<id> <exp>) is like a normal LET clause. There is no
; clause equivalent to
; (call-with-values (lambda () <expression>)
; (lambda <id> <body>))
(define-syntax mvlet
(syntax-rules ()
((mvlet () body ...)
(let () body ...))
((mvlet (clause ...) body ...)
(mvlet-helper (clause ...) () (body ...)))))
(define-syntax mvlet-helper
(syntax-rules ()
((mvlet-helper () clauses (body ...))
(let clauses body ...))
((mvlet-helper (((var . more-vars) val) more ...) clauses body)
(copy-vars (var . more-vars) () val (more ...) clauses body))
((mvlet-helper ((var val) more ...) clauses body)
(mvlet-helper (more ...) ((var val) . clauses) body))))
(define-syntax copy-vars
(syntax-rules ()
((copy-vars (var . more-vars) (copies ...)
val more clauses body)
(copy-vars more-vars (copies ... x)
val more ((var x) . clauses) body))
((copy-vars () copies val more clauses body)
(call-with-values
(lambda () val)
(lambda copies
(mvlet-helper more clauses body))))
((copy-vars last (copies ...) val more clauses body)
(call-with-values
(lambda () val)
(lambda (copies ... . lastx)
(mvlet-helper more ((last lastx) . clauses) body))))))
(define-syntax mvlet*
(syntax-rules ()
((mvlet* () body ...)
(let () body ...))
((mvlet* (((vars ...) val) clause ...) body ...)
(call-with-values
(lambda () val)
(lambda (vars ...)
(mvlet* (clause ...) body ...))))
((mvlet* ((var val) clause ...) body ...)
(let ((var val)) (mvlet* (clause ...) body ...)))))
|