(define-module (d-)
  #:use-module (srfi srfi-1)
  #:use-module (language tree-il)
  #:export
  (~>
   ~>>
   as~>
   if-not
   when-not
   if-let
   for
   partial
   argmin
   iterate
   upply
   generator
   macro-expand))

(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]
    [(~>> v (fn args ...) more ...) (~>> (fn args ... v) more ...)]
    [(~>> v fn more ...) (~>> (fn v) more ...)]))

(define-syntax as~>
  (syntax-rules ()
    [(_ as v) v]
    [(_ as v (fn args ...) more ...)
     (let [(as v)]
       (as~> as (fn args ...) more ...))]))

(define-syntax-rule (if-not pred body ...)
  (if (not pred) body ...))

(define-syntax-rule (when-not pred body ...)
  (when (not pred) body ...))

(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))))
	   '()))]))

(define (partial fn . args)
  (lambda x (apply fn (append args x))))

(define (argmin arg lt? . vals)
  (reduce (lambda (val min)
	    (if (lt? (arg val) (arg min))
		val
		min))
	  #f
	  vals))

(define (iterate n f v)
  (if (zero? n)
      v
      (iterate (1- n) f (f v))))

(define (upply a b cmp . fs)
  (let ([arm-f (apply compose fs)])
    (cmp (arm-f a) (arm-f b))))

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

(define-syntax generator
  (lambda (x)
    (syntax-case x ()
      [(generator expr ...)
       (with-syntax ([yield (datum->syntax x 'yield)])
	 #'(make-generator
	    (lambda (yield)
	      expr ...)))])))

;; Why wasn't this included?
(define macro-expand (compose tree-il->scheme macroexpand))