(define-module (com simatime core))

;;
;; old core, do i still need this?
;;

(define (not x)            (if x #f #t))
(define (null? obj)        (if (eqv? obj '()) #t #f))
(define (list objs)        objs)
(define (identity obj)     obj)
(define (flip f)           (lambda (x y) (f y x)))
(define (curry f a)        (lambda (b) (apply f (cons a (list b)))))
(define (compose f g)      (lambda (x) (f (apply g x))))
(define zero?              (curry = 0))
(define positive?          (curry < 0))
(define negative?          (curry > 0))
(define (odd? n)           (= (mod n 2) 1))
(define (even? n)          (= (mod n 2) 0))

(define (foldr f end lst)
  (if (null? lst)
    end
    (f (car lst) (foldr f end (cdr lst)))))

(define (foldl f acc lst)
  (if (null? lst)
    acc
    (foldl f (f acc (car lst)) (cdr lst))))

(define fold   foldl)

(define (unfold f init pred)
  (if (pred init)
    (cons init '())
    (cons init (unfold f (f init) pred))))

(define (mem* pred op)
  (lambda (acc next)
    (if (and (not acc) (pred (op next)))
      next
      acc)))

(define (sum lst)          (fold + 0 lst))
(define (produce lst)      (fold * 0 1 lst))

(define (max nums)
  (fold (lambda (x y) (if (> x y) x y))
        (car nums) (cdr nums)))

(define (min nums)
  (fold (lambda (x y) (if (< x y) x y))
        (car nums) (cdr nums)))

(define (length lst)       (fold (lambda (x y) (+ x 1)) 0 lst))
(define (reverse lst)      (fold (flip cons) '() lst))
(define (memq obj lst)     (fold (mem* (curry eq? obj) identity) #f lst))
(define (memv obj lst)     (fold (mem* (curry eqv? obj) identity) #f lst))
(define (member obj lst)   (fold (mem* (curry equal? obj) identity) #f lst))
(define (assq obj alist)   (fold (mem* (curry eq? obj) car) #f alist))
(define (assv obj alist)   (fold (mem* (curry eqv? obj) car) #f alist))
(define (assoc obj alist)  (fold (mem* (curry equal? obj) car) #f alist))
(define (map f lst)        (foldr (lambda (x y) (cons (f x) y)) '() lst))
(define (filter pred lst)  (foldr (lambda (x y) (if (pred x) (cons x y) y)) '() lst))


;;
;; clojure-like stuff
;;

(define (pr . a)
  (for-each display args))

(define (prn . a) (apply pr a) (newline))