loop.clj

(fn assert-tail [tail-sym body]
  "Asserts that the passed in tail-sym function is a tail-call position of the
passed-in body.

Throws an error if it is in a position to be returned or if the function is
situated to be called from a position other than the tail of the passed-in
body."
  (fn last-arg? [form i]
    (= (- (length form) 1) i))

  ;; Tail in special forms are (After macroexpanding):
  ;;
  ;; - Every second form in an if, or the last form
  ;; (if ... (sym ...) (sym ...))
  ;;
  ;; - Last form in a let
  ;; (let [] (sym ...))
  ;;
  ;; - Last form in a do
  ;; (do ... (sym ...))
  ;;
  ;; Anything else fails the assert
  (fn path-tail? [op i form]
    (if (= op 'if) (and (not= 1 i) (or (last-arg? form i) (= 0 (% i 2))))
        (= op 'let) (last-arg? form i)
        (= op 'do) (last-arg? form i)
        false))

  ;; Check the current form for the tail-sym, and if it's in a bad
  ;; place, error out. If we run into other forms, we recurse with the
  ;; comprehension if this is the tail form or not
  (fn walk [body ok]
    (let [[op & operands] body]
      (if (list? op) (walk op true)
          (assert-compile (not (and (= tail-sym op) (not ok)))
                          (.. (tostring tail-sym) " must be in tail position")
                          op)
          (each [i v (ipairs operands)]
            (if (list? v) (walk v (and ok (path-tail? op i body)))
                (assert-compile (not= tail-sym v)
                                (.. (tostring tail-sym) " must not be passed")
                                v))))))

  (walk `(do ,(macroexpand body)) true))


(fn loop [args ...]
  "Recursive loop macro.

Similar to `let`, but binds a special `recur` call that will reassign the values
of the bindings and restart the loop.

The first argument is a binding table with alternating symbols (or destructure
forms), and the values to bind to them.

For example:

```fennel
  (loop [[first & rest] [1 2 3 4 5]
         i 0]
    (if (= nil first)
        i
        (recur rest (+ 1 i))))
```

This would destructure the first table argument, with the first value inside it
being assigned to `first` and the remainder of the table being assigned to
`rest`. `i` simply gets bound to 0.

The body of the form executes for every item in the table, calling `recur` each
time with the table lacking its head element (thus consuming one element per
iteration), and with `i` being called with one value greater than the previous.

When the loop terminates (When the user doesn't call `recur`) it will return the
number of elements in the passed in table. (In this case, 5)"
  (let [recur (sym :recur)
        keys []
        gensyms []
        bindings []]
    (assert-tail recur ...)
    (each [i v (ipairs args)]
      (when (= 0 (% i 2))
        (let [key (. args (- i 1))
              gs (gensym i)]
          ;; Converts a form like
          ;; (loop [[first & rest] (expression)]
          ;;   ...)
          ;;
          ;; to code like:
          ;; (let [sym1# (expression)       ; bindings table
          ;;       [first & rest] sym1#]
          ;;   ((fn recur [[first & rest]]  ; keys table
          ;;      ...)
          ;;     sym1#))                    ; gensyms table, but unpacked
          ;;
          ;; That way it only evaluates once, and so destructuring
          ;; doesn't stomp us.

          ;; [sym1# sym2# etc...], for the function application below
          (table.insert gensyms gs)

          ;; let bindings
          (table.insert bindings gs) ;; sym1#
          (table.insert bindings v) ;; (expression)
          (table.insert bindings key) ;; [first & rest]
          (table.insert bindings gs) ;; sym1#

          ;; The gensyms we use for function application
          (table.insert keys key))))
    `(let ,bindings
       ((fn ,recur ,keys
          ,...)
        ,(table.unpack gensyms)))))