d-/d-.scm

70 lines
1.5 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-11-01 18:05:27 -05:00
if-let
for
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 ()
2024-11-01 18:05:27 -05:00
[(~> v) v]
[(~> v (fn args ...) more ...) (~> (fn v args ...) more ...)]
[(~> v fn more ...) (~> (fn v) more ...)]))
2024-10-23 09:02:27 -05:00
(define-syntax ~>>
(syntax-rules ()
2024-11-01 18:05:27 -05:00
[(~>> v) v]
[(~>> 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-11-01 18:05:27 -05:00
(define-syntax-rule (if-let ([ident test]) expr ...)
(let ([ident test])
(if ident
(begin expr ...)
#f)))
(define-syntax for
(syntax-rules ()
[(for () expr ...) (list (begin expr ...))]
[(for ([ident lst] bindings ...) expr ...)
(let iter ([rest lst])
(if (pair? rest)
(let ([ident (car rest)])
(append (for (bindings ...) expr ...) (iter (cdr rest))))
'()))]))
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))))