/usr/share/gauche-0.9/0.9.5/lib/srfi-26.scm is in gauche 0.9.5-1build1.
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 102 103 104 105 106 107 108 109 110 111 | ;;
;; SRFI-26
;;
;; This implementation is taken from http://srfi.schemers.org/srfi-26/
;; As shown below, originally written by Al Petrofsky and modified by
;; Sebastian Egner. Shiro Kawai adapted it for Gauche module system.
(define-module srfi-26
(export cut cute))
(select-module srfi-26)
; REFERENCE IMPLEMENTATION FOR SRFI-26 "CUT"
; ==========================================
;
; Sebastian.Egner@philips.com, 5-Jun-2002.
; adapted from the posting by Al Petrofsky <al@petrofsky.org>
;
; The code to handle the variable argument case was originally
; proposed by Michael Sperber and has been adapted to the new
; syntax of the macro using an explicit rest-slot symbol. The
; code to evaluate the non-slots for cute has been proposed by
; Dale Jordan. The code to allow a slot for the procedure position
; and to process the macro using an internal macro is based on
; a suggestion by Al Petrofsky. The code found below is, with
; exception of this header and some changes in variable names,
; entirely written by Al Petrofsky.
;
; compliance:
; Scheme R5RS (including macros).
;
; loading this file into Scheme 48 0.57:
; ,load cut.scm
;
; history of this file:
; SE, 6-Feb-2002: initial version as 'curry' with ". <>" notation
; SE, 14-Feb-2002: revised for <...>
; SE, 27-Feb-2002: revised for 'cut'
; SE, 03-Jun-2002: revised for proc-slot, cute
; SE, 04-Jun-2002: rewritten with internal transformer (no "loop" pattern)
; SE, 05-Jun-2002: replace my code by Al's; substituted "constant" etc.
; to match the convention in the SRFI-document
; (srfi-26-internal-cut slot-names combination . se)
; transformer used internally
; slot-names : the internal names of the slots
; combination : procedure being specialized, followed by its arguments
; se : slots-or-exprs, the qualifiers of the macro
(define-syntax srfi-26-internal-cut
(syntax-rules (<> <...>)
;; construct fixed- or variable-arity procedure:
;; Original code wraps proc in the first clause by (begin proc), hoping
;; the implementation to detect an error in case proc is a macro or a
;; syntax; but in Gauche such error detection is delayed until runtime
;; anyway, and using (begin proc) suppresses inlining proc, so we
;; modified it.
((srfi-26-internal-cut (slot-name ...) (proc arg ...))
(lambda (slot-name ...) (proc arg ...)))
((srfi-26-internal-cut (slot-name ...) (proc arg ...) <...>)
(lambda (slot-name ... . rest-slot) (apply proc arg ... rest-slot)))
;; process one slot-or-expr
((srfi-26-internal-cut (slot-name ...) (position ...) <> . se)
(srfi-26-internal-cut (slot-name ... x) (position ... x) . se))
((srfi-26-internal-cut (slot-name ...) (position ...) nse . se)
(srfi-26-internal-cut (slot-name ...) (position ... nse) . se))))
; (srfi-26-internal-cute slot-names nse-bindings combination . se)
; transformer used internally
; slot-names : the internal names of the slots
; nse-bindings : let-style bindings for the non-slot expressions.
; combination : procedure being specialized, followed by its arguments
; se : slots-or-exprs, the qualifiers of the macro
(define-syntax srfi-26-internal-cute
(syntax-rules (<> <...>)
;; If there are no slot-or-exprs to process, then:
;; construct a fixed-arity procedure,
((srfi-26-internal-cute
(slot-name ...) nse-bindings (proc arg ...))
(let nse-bindings (lambda (slot-name ...) (proc arg ...))))
;; or a variable-arity procedure
((srfi-26-internal-cute
(slot-name ...) nse-bindings (proc arg ...) <...>)
(let nse-bindings (lambda (slot-name ... . x) (apply proc arg ... x))))
;; otherwise, process one slot:
((srfi-26-internal-cute
(slot-name ...) nse-bindings (position ...) <> . se)
(srfi-26-internal-cute
(slot-name ... x) nse-bindings (position ... x) . se))
;; or one non-slot expression
((srfi-26-internal-cute
slot-names nse-bindings (position ...) nse . se)
(srfi-26-internal-cute
slot-names ((x nse) . nse-bindings) (position ... x) . se))))
; exported syntax
(define-syntax cut
(syntax-rules ()
((cut . slots-or-exprs)
(srfi-26-internal-cut () () . slots-or-exprs))))
(define-syntax cute
(syntax-rules ()
((cute . slots-or-exprs)
(srfi-26-internal-cute () () () . slots-or-exprs))))
|