This commit is contained in:
Victor Fors 2021-11-27 17:59:51 +01:00
parent aa76655755
commit 610cfe6952

View File

@ -1,28 +1,39 @@
;;; Module storing utility functions for common use.
(module util (curry applied thunk just perhaps compose-symbols) (module util (curry applied thunk just perhaps compose-symbols)
(import scheme) (import scheme)
(import chicken.base) (import chicken.base)
(import srfi-13) (import srfi-13)
;; Partial application function for binary functions.
(define (curry fn a) (define (curry fn a)
(lambda (b) (lambda (b)
(fn a b))) (fn a b)))
;; Make a function applied, as per (applied +) = (lambda (ln) (+ (car ln) (cdr ln))).
(define (applied fn) (define (applied fn)
(curry apply fn)) (curry apply fn))
;; Take a list of expressions and wrap them in a thunk.
(define-syntax thunk (define-syntax thunk
(syntax-rules () (syntax-rules ()
((_ exp ...) ((_ exp ...)
(lambda () 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) (define (just fn)
(lambda args (lambda args
(fn))) (fn)))
;; Haskell Maybe lifting pattern equivalent for booleans,
;; apply fn to arg if arg is not false.
(define (perhaps fn arg) (define (perhaps fn arg)
(if arg (if arg
(fn arg) (fn arg)
arg)) arg))
;; Compose the argument symbols into a new symbol, joined by '-'.
;; (compose-symbols 'apple 'pear 'orange) = 'apple-pear-orange
(define (compose-symbols . ln) (define (compose-symbols . ln)
(string->symbol (string-concatenate (intersperse (map symbol->string ln) "-"))))) (string->symbol (string-concatenate (intersperse (map symbol->string ln) "-")))))