kekkonen/util.scm

;;; 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) "-")))))