This file is indexed.

/usr/share/gauche-0.9/0.9.5/lib/srfi-26.scm is in gauche 0.9.5-1.

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))))