/usr/lib/s9fes/hof.scm is in scheme9 2010.11.13-2.
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 | ; Scheme 9 from Empty Space, Function Library
; By Nils M Holm, 2010
; See the LICENSE file of the S9fES package for terms of use
;
; (complement procedure) ==> procedure
; (compose procedure1 procedure2 ...) ==> procedure
; (const <expression>) ==> procedure
; (curry procedure object ...) ==> procedure
; (fork procedure1 procedure2) ==> procedure
;
; (load-from-library "hof.scm")
;
; COMPOSE combines the given procedures to form a new procedure
;
; (lambda args (p1 ... (apply pN args) ...))
;
; where the procedures P1 through P(N-1) must be unary; the last
; procedure may take any number of arguments.
;
; COMPLEMENT returns a predicate expressing the complement of the given
; procedure (which should also be a predicate).
;
; CONST generates a procedure that discards any arguments passed to it
; and always evaluates to <expression>. <Expression> evaluated each time
; the procedure delivered by CONST is called.
;
; CURRY partially applies PROCEDURE to the given OBJECTs, resulting
; in a new procedure
;
; (lambda args (apply p object ... args))
;
; Application of the given PROCEDURE is finished when the procedure
; returned by CURRY is applied to some arguments.
;
; FORK arranges two procedures to form a fork:
;
; ((fork f g) x1 ... xN) --> (f (g x1) ... (g xN))
;
; Example: ((complement pair?) '(1 2 3)) ==> #f
; ((complement eq?) 'foo 'bar) ==> #t
;
; ((compose car cdr) '(1 2 3)) ==> 2
; ((compose list reverse list) 1 2 3) ==> ((3 2 1))
;
; ((const (+ 1 2))) ==> 3
; ((const (+ 1 2)) 3 4 5) ==> 3
;
; ((curry + 1) 9) ==> 10
; ((curry map list) '(1 2 3)) ==> ((1) (2) (3))
;
; ((fork < car) '(1 . a) '(2 . b) '(3 . c)) ==> #t
; ((fork append reverse) '(3 2 1) '(6 5 4)) ==> (1 2 3 4 5 6)
(define-syntax (compose . f*)
(if (null? f*)
(error "compose: too few arguments")
(let ((arg (gensym)))
(let ((body (let loop ((f* f*))
(if (null? (cdr f*))
`(apply ,(car f*) ,arg)
`(,(car f*) ,(loop (cdr f*)))))))
`(lambda ,arg ,body)))))
(define (complement p)
(lambda x
(not (apply p x))))
(define-syntax (curry f . x)
(let ((y (gensym)))
`(lambda ,y (apply ,f ,@x ,y))))
(define (fork f g)
(lambda x
(apply f (map g x))))
(define-syntax (const x)
(let ((y (gensym)))
`(lambda ,y ,x)))
|