Carp/core/List.carp

(defmodule Dynamic

  (doc cxr "takes a specification of a traversal in `a` (head) and `d` (tail)
symbols and a list `pair` to traverse.

Example:
```
(cxr '(1 a 1 d) '(1 2 3)) ; => 2

(cxr '(1 a 1 d 1 a 4 d) '(1 2 3 4 (5 6 7))) ; => 6
```")
  (defndynamic cxr [x pair]
    (cond
      (= (length x) 0) pair
      (= 0 (car x)) (cxr (cddr x) pair)
      ((cond
        (= 'a (cadr x)) car
        (= 'd (cadr x)) cdr
        (macro-error "`cxr` expects either `a` or `d` symbols, got " (cadr x)))
       (if (= 1 (car x))
         (cxr (cddr x) pair)
         (cxr (cons (- (car x) 1) (cdr x)) pair)))))

  (doc nthcdr "takes the `n`th tail or `cdr` of the list `pair`.")
  (defndynamic nthcdr [n pair]
    (cxr (list (+ n 1) 'd) pair))

  (doc nthcar "takes the `n`th head or `car` of the list `pair`.")
  (defndynamic nthcar [n pair]
    (cxr (list 1 'a n 'd) pair))

  (hidden collect-into-internal)
  (defndynamic collect-into-internal [xs acc f]
    (if (= 0 (length xs))
        acc
        (collect-into-internal (cdr xs) (append acc (f (car xs))) f)))

  (doc collect-into
       "Transforms a dynamic data literal into another, preserving order")
  (defndynamic collect-into [xs f]
    (collect-into-internal xs (f) f))

  (doc empty?
       "Returns true if the provided data literal is empty, false otherwise.")
  (defndynamic empty? [xs]
    (= 0 (length xs)))

  (doc reduce
       "Reduces or 'folds' a data literal, such as a list or array, into a single"
       "value through successive applications of `f`.")
  (defndynamic reduce [f x xs]
    (if (empty? xs)
      x
      (reduce f (f x (car xs)) (cdr xs))))

  (hidden unreduce-internal)
  (defndynamic unreduce-internal [f x lim acc counter]
    ;; Currently only works with anonymous functions and named functions.
    ;; does not work with commands.
    (if (not (or (array? acc) (list? acc)))
      (macro-error
       "Unreduce requires a dynamic data structure to collect results, such as
         (list) or (array).")
      (if (= counter lim)
        acc
        (unreduce-internal f (f x) lim (append acc (cons (eval (f x)) (empty acc))) (+ counter 1)))))

  (doc unreduce
       "Applies `f` to a starting value `x`, then generates a sequence of values"
       "by successively applying `f` to the result `lim-1` times."
       "Collects results in the structure given by `acc`."
       ""
       "```"
       "(unreduce (curry + 1) 0 10 (list))"
       "=> (1 2 3 4 5 6 7 8 9 10)"
       "```")
  (defndynamic unreduce [f x lim acc]
    (unreduce-internal f x lim acc 0))

  (doc filter
       "Returns a list containing only the elements of `xs` that satisify"
       "predicate `p`."
       ""
       "```"
       "(filter (fn [x] (= 'a x)) '(a b a b a b a b))"
       "=> (a a a a)"
       "```")
  (defndynamic filter [p xs]
    (let [filter-fn (fn [x y] (if (p y) (append x (list y)) x))]
      (reduce filter-fn (list) xs)))

  (doc reverse
       "Reverses the order of elements in an array or list."
       ""
       "```"
       "(reverse [1 2 3 4])"
       "=> [4 3 2 1]"
       "```")
  (defndynamic reverse [xs]
    (if (array? xs)
      (reduce (flip append) (array) (map array xs))
      (reduce (flip append) (list) (map list xs))))

  (doc empty
       "Returns the empty form of `xs`."
       ""
       "```"
       "(empty '(1 2 3 4))"
       "=> ()"
       "(empty '[1 2 3 4])"
       "=> []"
       "```")
  (defndynamic empty [xs]
    (if (array? xs)
      (array)
      (list)))

  (doc take
       "Returns a list containing the first `n` elements of a list."
       ""
       "```"
       "(take 3 '(1 2 3 4 5))"
       "=> (1 2 3)"
       "```")
  (defndynamic take [n xs]
    ;; A more straightforward impl is likely more efficient?
    (let [indicies (unreduce (curry + 1) 0 n (list))
          result (map cadr (zip list xs indicies))]
      (if (array? xs)
        (collect-into result array)
        result)))

  (doc apply
       "Applies the function `f` to the provided argument list, passing each value"
       "in the list as an argument to the function.")
  (defndynamic apply [f argument-list]
    ;; The let clause here is a tad mysterious at first glance. When passed a
    ;; standalone function name (i.e. not an application (f x), carp evaluates
    ;; it into the function's defining form, e.g. foo becomes (defn foo [x] x),
    ;; commands such as + become (command +) etc.  ;; The binding here accounts
    ;; for that case, allowing users to pass the function name to apply
    ;; unquoted.
    ;;
    ;; This is necessary for parity across map-internal, zip, and apply.
    ;; Since map calls its function directly, it takes it as is. Apply, on the
    ;; other hand, would have to take the quoted form, since it builds a list
    ;; that serves as the actual application.
    ;;
    ;; This is problematic for the user facing map function, since it makes
    ;; calls to map or zip (which uses apply) as appropriate--unless we support
    ;; the quoted function name argument in map-internal or the unquoted one in
    ;; apply, we can't use zip and map-internal in map.
    (if (not (list? f))
      (f argument-list)
      (let [function-name (list (cadr f))]
        (if (array? argument-list)
          (append function-name (collect-into argument-list list))
          (append function-name argument-list)))))

  (doc any?
       "Checks whether any of the elements in `xs` conforms to the predicate"
       "function `f`."
       ""
       "```"
       "(any? (fn [x] (= 'a x)) '(a b c))"
       "=> true"
       "(any? (fn [x] (= 'a x)) '(e f g))"
       "=> false"
       "```")
  (defndynamic any? [f xs]
    (reduce (fn [acc x] (or acc (f x))) false xs))

  (doc all?
       "Checks whether all of the elements in `xs` conform to the predicate"
       "function `f`."
       ""
       "```"
       "(all? (fn [x] (< 1 x)) '(2 3 4))"
       "=> true"
       "(all? (fn [x] (< 1 x)) '(-1 0 1))"
       "=> false"
       "```")
  (defndynamic all? [f xs]
    (reduce (fn [acc x] (and acc (f x))) true xs))

  (hidden zip-internal)
  (defndynamic zip-internal [f forms acc]
    (if (any? empty? forms)
      acc
      (zip-internal
       f
       (map-internal cdr forms (list))
       (let [result (list (apply f (map-internal car forms (list))))]
         (append acc result)))))

  (doc zip
       "Returns the *form* that results from applying  a function `f` to each of"
       "the values supplied in `forms`."

       "If the members of a single form are exhuasted, the result of the"
       "applications thus far is returned, and any remaining members in the other"
       "forms are ignored."
       ""
       "```"
       "(zip + '(1 2 3) '(4 5 6))"
       "=> ((+ 1 4) (+ 2 5) (+ 3 6))"
       "```"
       ""
       "It's important to note that zip operates on forms, and that the form"
       "returned by zip may not be evaluable by itself. For instance, to actually"
       "transform the result in the example above into something Carp can"
       "evaluate, we need to wrap each member of the list in a `do`:"
       ""
       "```"
       "(append (list 'do) (zip + '(1 2 3) '(4 5 6)))"
       "=> (do (+ 1 4) (+ 2 5) (+ 3 6))"
       "(eval (append (list 'do) (zip + '(1 2 3) '(4 5 6))))"
       "=> 9 ;; do returns the value of the last form in its body"
       "```")
  (defndynamic zip [f :rest forms]
    (zip-internal f forms (list)))

  (doc map
       "Applies a function `f` to each element in the list or array `xs` and"
       "returns a list dynamic data literal containing the result of the function"
       "applications."
       ""
       "```"
       "'(map symbol? '(a b c))"
       "=> (true true true)"
       "'(map (curry + 1) '(1 2 3))"
       "=> (2 3 4)"
       "```")
  (defndynamic map [f xs]
    (map-internal f xs (list)))

  (doc flatten
       "Flattens a list recursively."
       ""
       "```"
       "(flatten '(1 2 (3 (4))))"
       "=> '(1 2 3 4)"
       "```")
  (defndynamic flatten [l]
    (reduce (fn [acc x]
              (if (list? x)
                (append acc (flatten x))
                (cons-last x acc)))
            '()
            l))

  (doc walk "traverses `form`, an arbitrary data structure, using the functions
`inner` and `outer`. It will apply `inner` to each element of `form`, building
up a data structure of the same type, then applies `outer` to the result. It
recognizes arrays and lists. Other data structures will just be passed to
`outer`.

Example:
```
(walk car reverse [[1 2] [3 4] [5 6]]) ; => [5 3 1]
```")
  (defndynamic walk [inner outer form]
    (cond
      (list? form) (outer (map inner form))
      (array? form) (outer (collect-into (map inner form) array))
      (outer form)))

  (doc postwalk "Performs a depth-first, post-order traversal of `form` and
calls `f` on each subform, collecting the result.

Example:
```
; note: this could be achieved using `walk-replace` as well
(postwalk (fn [x]
            (cond
              (= x '+) '*
              (= x '-) '/
              x))
          '(+ 1 (- 2 3))) ; => (* 1 (/ 2 3))
```")
  (defndynamic postwalk [f form]
    (walk (curry postwalk f) f form))

  (doc prewalk "behaves like [`postwalk`](#postwalk), but does pre-order
traversal.

Example:
```
(prewalk (fn [x] (if (number? x) (* x 4) x)) '(+ 1 (- 2 3))) ; => (+ 4 (- 8 12))
```")
  (defndynamic prewalk [f form]
    (walk (curry prewalk f) (fn [x] x) (f form)))

  (hidden walk-replace-finder)
  (defndynamic walk-replace-finder [p el]
    (if (empty? p)
      p
      (let [f (car p)]
        (if (= (car f) el)
          f
          (walk-replace-finder (cdr p) el)))))

  (doc walk-replace "Performs a depth-first, pre-order traversal of `form` and
finds a matching replacement for each subform in the replacement pairs `pairs`,
if applicable, collecting the result.

Example:
```
(walk-replace '((+ *) (- /)) '(+ 1 (- 2 3))) ; => (* 1 (/ 2 3))
```")
  (defndynamic walk-replace [pairs form]
    (prewalk (fn [x]
               (let [r (walk-replace-finder pairs x)]
                 (if (empty? r) x (cadr r))))
             form))
  (doc sort "Sorts a list using the provided predicate. It is not a stable sort.
Example:
```
(sort '(1 3 4 2 5 4) <) ; => (1 2 3 4 4 5)
(sort '(1 3 4 2 5 4) >) ; => (5 4 4 3 2 1)
(sort '(\"one\" \"two---\" \"three\" \"four\") (fn [a b] (< (String.length a) (String.length b)))) ; => (\"one\" \"four\" \"three\" \"two---\")
```")
  (defndynamic sort [l compare]
    (if (nil? l)
      '()
      (let [x (car l)
            xs  (cdr l)
            lower-filtered (filter (fn [y] (compare y x)) xs)
            lower-sorted (Dynamic.sort lower-filtered compare)
            higher-filtered (filter (fn [y] (not (compare y x))) xs)
            higher-sorted (Dynamic.sort higher-filtered compare)]
       (append lower-sorted (append (list x) higher-sorted)))))

  (defmodule List
    (doc pairs "makes a list of pairs out of a list `l`. If the number of
elements is uneven, the trailing element will be discarded.")
    (defndynamic pairs [l]
      (if (< (length l) 2)
        '()
        (cons (list (car l) (cadr l)) (List.pairs (cddr l)))))

    (doc nth "gets the nth element of the list `l`.")
    (defndynamic nth [l n]
      (cond
        (empty? l) '()
        (= n 0) (car l)
        (List.nth (cdr l) (dec n))))

    (doc remove-nth "removes the nth element from the list `l`.")
    (defndynamic remove-nth [l n]
      (cond
        (empty? l) '()
        (= n 0) (cdr l)
        (cons (car l) (List.remove-nth (cdr l) (dec n)))))

    (doc update-nth "updates the nth element of the list `l` using the function `f`.")
    (defndynamic update-nth [l n f]
      (cond
        (empty? l) '()
        (= n 0) (cons (f (car l)) (cdr l))
        (cons (car l) (List.update-nth (cdr l) (dec n) f))))

    (doc set-nth "sets the nth element of the list `l` to the value `v`.")
    (defndynamic set-nth [l n elem]
      (List.update-nth l n (fn [_] elem)))

    (doc find
      "finds the first element in the list `l` that matches `pred`.

Returns `nil` on failure")
    (defndynamic find [l pred]
      (cond
        (empty? l) '()
        (pred (car l)) (car l)
        (List.find (cdr l) pred)))

    (doc find-index "like [`find](#find), but returns the index instead.

Returns `nil` on failure")
    (defndynamic find-index [l pred]
      (cond
        (empty? l) '()
        (pred (car l)) 0
        (let [res (List.find-index (cdr l) pred)]
          (if (nil? res)
            res
            (inc res)))))))