50 righe
1.3 KiB
Scheme
50 righe
1.3 KiB
Scheme
;;; Module storing utility functions for common use.
|
|
|
|
(module util (curry applied thunk just perhaps compose-symbols mapn)
|
|
(import scheme)
|
|
(import chicken.base)
|
|
(import srfi-13)
|
|
(import matchable)
|
|
|
|
;; Partial application function for binary functions.
|
|
(define (curry fn a)
|
|
(lambda (b)
|
|
(fn a b)))
|
|
|
|
;; Make a function applied, as per (applied +) = (lambda (ln) (+ (car ln) (cdr ln))).
|
|
(define (applied fn)
|
|
(curry apply fn))
|
|
|
|
;; Take a list of expressions and wrap them in a thunk.
|
|
(define-syntax thunk
|
|
(syntax-rules ()
|
|
((_ exp ...)
|
|
(lambda () exp ...))))
|
|
|
|
;; Wrap a thunk in a function that discards all its arguments
|
|
;; and returns the result of evaluating the thunk.
|
|
(define (just fn)
|
|
(lambda args
|
|
(fn)))
|
|
|
|
;; Haskell Maybe lifting pattern equivalent for booleans,
|
|
;; apply fn to arg if arg is not false.
|
|
(define (perhaps fn arg)
|
|
(if arg
|
|
(fn arg)
|
|
arg))
|
|
|
|
(define (mapn fn ln)
|
|
(match ln
|
|
(() '())
|
|
((x) (fn x))
|
|
(_ (begin
|
|
(fn (car ln))
|
|
(mapn fn (cdr ln))))))
|
|
|
|
|
|
;; Compose the argument symbols into a new symbol, joined by '-'.
|
|
;; (compose-symbols 'apple 'pear 'orange) = 'apple-pear-orange
|
|
(define (compose-symbols . ln)
|
|
(string->symbol (string-concatenate (intersperse (map symbol->string ln) "-")))))
|