util.zp

(define (id obj)
  "take anything and return it as is.

   params:
    - obj: what to return; can be anything
   complexity: O(1)
   returns: <par>obj</par>"
  obj)

(define (inf? obj)
  "check whether <par>obj</par> is <zepto>inf</zepto>.

   params:
     - obj: the object to check
   complexity: O(1)
   returns: boolean"
  (if (and (number? obj) (inexact? obj))
    (= obj (* obj 10))
    #f))

(define (flip func)
  "take a function <par>func</par> and return a function that
   applies the arguments to <par>func</par> in reverse. Assumes a binary function.

   params:
    - func: the function to change
   complexity: O(1)
   returns: the flipped function"
  (lambda (arg1 arg2)
    (func arg2 arg1)))

(define (curry f . args)
  "curry a function <par>f</par> by providing any number of arguments.
   It will return a function that takes any number of arguments and then
   applies the first and second set of arguments together to <par>f</par>.

   Example:
   <zepto>
    (define plus10 (curry + 10))
    (plus10 40) ; 50
   </zepto>

   params:
     - f: the function to curry
     - args: the first set of arguments to apply to <par>f</par>
   complexity: O(1)
   returns: the curried function"
  (lambda inner
    (apply f (++ args inner))))

(define (compose f g . args)
  "compose two functions <par>f</par> and <par>g</par> together.
   If arguments are provided, it gets applied right away. If no arguments
   are provided, a function is returned that takes any number of arguments,
   calls <par>g</par> with them and then pipes it into <par>f</par>.

   Example:
   <zepto>
     (define incrfirst (compose add1 head))
     (incrfirst [1 2 3]) ; => 2

     (compose sub1 list:last [4 5 6]) ; => 5
  </zepto>

  params:
    - f: the outer function
    - g: the inner function
    - args: any number of arguments (optional); if provided, the composition gets evaluated right away
  complexity: O(1)
  returns: the composition of <par>f</par> and <par>g</par> or the applied version"
  (let ((constructed (lambda args (f (apply g args)))))
    (if (null? args)
      constructed
      (apply compose (cons constructed args)))))

(define (foldr func end l)
  "fold right over a list <par>l</par> using <par>func</par> and an initial
   accumulator <par>accum</par>.

   params:
    - func: the function used for folding
    - accum: the initial accumulator
    - l: the list to fold over
   complexity: O(n*k) (where n is the length of the list and k is the complexity of <par>fun</par>)
   returns: whatever <par>fun</par> reduces"
  (if (list:null? l)
    end
    (func (list:car l) (foldr func end (list:cdr l)))))

(define (foldr1 func l)
  "fold right over a list <par>l</par> using <par>func</par>. Assume the first element
   of <par>l</par> is the valid accumulator.

   params:
    - func: the function used for folding
    - l: the list to fold over
   complexity: O(n*k) (where n is the length of the list and k is the complexity of <par>fun</par>)
   returns: whatever <par>fun</par> reduces"
  (foldr func (car l) (cdr l)))

(define (foldl1 func l)
  "fold left over a list <par>l</par> using <par>func</par>. Assume the first element
   of <par>l</par> is the valid accumulator.

   params:
    - func: the function used for folding
    - l: the list to fold over
   complexity: O(n*k) (where n is the length of the list and k is the complexity of <par>fun</par>)
   returns: whatever <par>fun</par> reduces"
  (foldl func (car l) (cdr l)))

(define (sum . l)
  "calculate the sum of the values provided to <par>l</par>.

   params:
     - l: the values that should be summed (varargs)
   complexity: O(n)
   returns: the sum of all values in <par>l</par>"
  (fold + 0 l))

(define (product . l)
  "calculate the product of the values provided to <par>l</par>.

   params:
     - l: the values that should be multiplied (varargs)
   complexity: O(n)
   returns: the product of all values in <par>l</par>"
  (fold * 1 l))

(define (for-each proc . lists)
  "applies a function <par>proc</par> to a variable number of lists
   and return a list of lists. Returns when the shortest list is traversed.

   params:
     - proc: the function to apply
     - lists: a number of lists (varargs)
   complexity: O(n*m*k) where n is the length of the shortest list, m is the number of lists, and k is the complexity of <par>k</par>
   returns: a list of lists"
  (define (unzip1-with-cdr . lists)
    (unzip1-with-cdr-iterative lists '() '()))
  (define (unzip1-with-cdr-iterative lists cars cdrs)
    (if (null? lists)
        (cons cars cdrs)
        (let ((car1 (caar lists))
          (cdr1 (cdar lists)))
      (unzip1-with-cdr-iterative 
       (cdr lists) 
       (append cars car1)
       (append cdrs cdr1)))))

  (if (null? lists)
      []
      (if (any? null? lists)
        []
        (let* ((unz (apply unzip1-with-cdr lists))
               (cars (car unz))
               (cdrs (cdr unz)))
          (cons
            (apply proc cars)
            (apply for-each (cons proc cdrs)))))))

(define (falsy? val)
  "checks whether <par>val</par> is falsy, i.e. empty if it is a
   collection, 0 if it is a number, and false if it is a boolean.
   TODO: make this a protocol

   params:
     - val: the value to check
   complexity: O(1)
   returns: boolean"
  (cond
    ((boolean? val) (not val))
    ((hash-map? val) (list:null? (hash:keys val)))
    ((list? val) (list:null? val))
    ((vector? val) (eqv? {} val))
    ((byte-vector? val) (eqv? #() val))
    ((string? val) (eqv? "" val))
    ((number? val) (eqv? 0 val))
    (else #t)))

(define (truthy? val)
  "checks whether <par>val</par> is truthy, i.e. not empty if it is a
   collection, !0 if it is a number, and true if it is a boolean.
   TODO: make this a protocol

   params:
     - val: the value to check
   complexity: O(1)
   returns: boolean"
  (not (falsy? val)))

(define (constantly x)
  "takes an argument <par>x</par> and returns a function that takes
   any number of arguments and returns <par>x</par>.

   params:
     - x: the argument to return
   complexity: O(1)
   returns: a function that returns <par>x</par>"
  (lambda args x))

(define (juxt . fs)
  "takes a set of functions and returns a function that is the juxtaposition
   of those functions. The returned function takes a variable number of args,
   and returns a vector containing the result of applying each given function
   to the args (left-to-right).

   params:
    - fs: the functions to juxtapose (varargs)
   complexity: O(1)
   returns: the juxtaposition of <par>fs</par>"
  (lambda args (map ($ (apply % args)) fs)))

(define (memoize f)
  "returns a memoized version of a referentially transparent function. The
   memoized version of the function keeps a cache of the mapping from arguments
   to results and, when calls with the same arguments are repeated often, has
   higher performance at the expense of higher memory use.
   Caveat: the arguments must be simple values.

   params:
     - f: the function to memoize
   complexity: O(1)
   returns: a memoized version of <par>f</par>"
  (let ((cache #{}))
    (lambda args
      (let ((sargs (make-simple-list args)))
        (if (in? cache sargs)
          (cache sargs)
          (let ((res (apply f args)))
            (begin
              (hash:set! cache sargs res)
              res)))))))

(define (partition n c)
  "returns a list of lists of <par>n</par> items each, throws away the rest.

   params:
    - n: the size of the slices
    - c: the source collection (can be any collection type)
   complexity: O(n)
   returns: a list of lists"
  (define (internal acc tmp src)
    (cond
      ((null? src) acc)
      ((eq? (length tmp) n) (internal (+= acc tmp) (list (car src)) (cdr src)))
      (else (internal acc (++ tmp (car src)) (cdr src)))))
  (internal [] [] c))

(define (partition-all n c)
  "returns a list of lists of <par>n</par> items each, does not throw away the rest.

   params:
    - n: the size of the slices
    - c: the source collection (can be any collection type)
   complexity: O(n)
   returns: a list of lists"
  (define (internal acc tmp src)
    (cond
      ((null? src) (+= acc tmp))
      ((eq? (length tmp) n) (internal (+= acc tmp) (list (car src)) (cdr src)))
      (else (internal acc (++ tmp (car src)) (cdr src)))))
  (internal [] [] c))

(define (callable? obj)
  "check whether <par>obj</par> is callable.

   params:
    - obj: the object to check
   complexity: O(1)
   returns: a boolean"
  (or (function? obj) (primitive? obj)))

(define (ignoring pred f)
  "takes a predicate and a function and returns a function
   that filters out any argument to f that matches pred before
   applying them.

   params:
    - pred: the predicate
    - f: the function
   complexity: O(1)
   returns: a new function as described above"
  (lambda args
    (apply f (filter ($ (not (pred %))) args))))

(define (ignoring-nils f)
  "a specialized version of <par>ignoring</par> that ignores nil values.

   params:
     - f: the function
   complexity: O(1)
   returns: a new function as described in the documentation of <par>ignoring</par>"
  (ignoring nil? f))

(define (rate-limited f period)
  "creates a version of the function <par>f</par> which 'refuses' to be called too
   frequently. If it has successfully been called in the last <par>period</par>
   milliseconds, calls to it will return nil; if no calls have succeeded in that
   period, it will be called with the args provided.

   params:
     - f: the function
     - period: the number of milliseconds
   complexity: O(1)
   returns: a new function as described above"
  (let ((last-call 0))
    (lambda args
      (let* ((time (unix-timestamp))
             (cur (/ (+ (* (car time) 1000000000) (cadr time)) 1000000)))
        (if (< (+ period last-call) cur)
          (begin
            (set! last-call cur)
            (apply f args)))))))

(define (unfold next seed)
  "Traditionally unfold is the 'opposite of reduce': it turns a single
  seed value into a sequence of output values.

  <par>next</par> is a function that operates on a <par>seed</par>: it should
  return a pair, <zepto>[value new-seed]</zepto>; the value half of the pair is
  inserted into the resulting list, while the new seed is used to
  continue unfolding. Notably, the value is never passed as an
  argument to <par>next</par>. If <zepto>nil</zepto> is returned instead of a pair,
  the resulting sequence will terminate.

  Example:
  <zepto>
  (define (fibs-to n)
    (unfold (lambda (a b)
              (if (> b n)
                (nil)
                (list a (list b (+ a b)))))
             [0 1]))
  </zepto>

  params:
    - next: the function that produces values
    - seed: the original seeding value
  complexity: O(n*k) where k is the complexity of <par>next</par>
  returns: a list of the values produced by <par>next</par>"
  (let loop ((acc [])
             (nval (apply next seed)))
    (if (nil? nval)
      acc
      (loop (++ acc (car nval)) (apply next (cadr nval))))))