d-/d-.scm

52 lines
1.1 KiB
Scheme
Raw Normal View History

2024-10-23 09:02:27 -05:00
(define-module (d-)
2024-10-25 15:16:04 -05:00
#:use-module (srfi srfi-1)
2024-10-23 09:02:27 -05:00
#:export
(~>
~>>
2024-10-25 15:48:01 -05:00
if-not
when-not
2024-10-25 15:16:04 -05:00
partial
2024-10-29 11:41:50 -05:00
argmin
make-generator))
2024-10-23 09:02:27 -05:00
(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]
2024-10-28 12:41:35 -05:00
[(_ v (fn args ...) more ...) (~>> (fn args ... v) more ...)]
[(_ v fn more ...) (~>> (fn v) more ...)]))
2024-10-23 09:02:27 -05:00
2024-10-25 15:48:01 -05:00
(define-syntax-rule (if-not pred body ...)
(if (not pred) body ...))
(define-syntax-rule (when-not pred body ...)
(when (not pred) body ...))
2024-10-23 09:02:27 -05:00
(define (partial fn . args)
(lambda x (apply fn (append args x))))
2024-10-25 15:16:04 -05:00
(define (argmin f . vals)
(reduce (lambda (val min)
(if (< (f val) (f min))
val
min))
#f
vals))
2024-10-29 11:41:50 -05:00
;; 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))))