52 lines
1.1 KiB
Scheme
52 lines
1.1 KiB
Scheme
(define-module (d-)
|
|
#:use-module (srfi srfi-1)
|
|
#:export
|
|
(~>
|
|
~>>
|
|
if-not
|
|
when-not
|
|
partial
|
|
argmin
|
|
make-generator))
|
|
|
|
(define-syntax ~>
|
|
(syntax-rules ()
|
|
[(_ v) v]
|
|
[(_ v (fn args ...) more ...) (~> (fn v args ...) more ...)]
|
|
[(_ v fn more ...) (~> (fn v) more ...)]))
|
|
|
|
(define-syntax ~>>
|
|
(syntax-rules ()
|
|
[(_ v) v]
|
|
[(_ v (fn args ...) more ...) (~>> (fn args ... v) more ...)]
|
|
[(_ v fn more ...) (~>> (fn v) more ...)]))
|
|
|
|
(define-syntax-rule (if-not pred body ...)
|
|
(if (not pred) body ...))
|
|
|
|
(define-syntax-rule (when-not pred body ...)
|
|
(when (not pred) body ...))
|
|
|
|
(define (partial fn . args)
|
|
(lambda x (apply fn (append args x))))
|
|
|
|
(define (argmin f . vals)
|
|
(reduce (lambda (val min)
|
|
(if (< (f val) (f min))
|
|
val
|
|
min))
|
|
#f
|
|
vals))
|
|
|
|
;; Shamelessly ripped from https://wingolog.org/archives/2013/02/25/on-generators
|
|
(define (make-generator f)
|
|
(define tag (make-prompt-tag))
|
|
(define (thunk)
|
|
(f (lambda (val) (abort-to-prompt tag val))))
|
|
(lambda ()
|
|
(call-with-prompt tag
|
|
thunk
|
|
(lambda (k value)
|
|
(set! thunk k)
|
|
value))))
|