(examples-for destructure/with

("with just one arg"
 (destructure/with 'xxx '(a) 0)
 (a (nth 0 xxx)))

("with several args"
 (destructure/with 'xxx '(a b (c d) e) 0)
 (a     (nth 0 xxx)
  b     (nth 1 xxx)
  (c d) (nth 2 xxx)
  e     (nth 3 xxx)))

("with several complex args and a rest-arg"
 (destructure/with 'xxx '(a (b c) (d (e f)) g . h) 0)
 (a          (nth 0 xxx)
  (b c)      (nth 1 xxx)
  (d (e f))  (nth 2 xxx)
  g          (nth 3 xxx)
  h          (nthcdr 4 xxx))))

(examples-for destructure/build

("with no args"
 (destructure/build nil nil '(x) (fn (a b) `(fn ,a ,@b)))
 (fn nil x))

("with one arg"
 (destructure/build '(a) nil '(x) (fn (a b) `(fn ,a ,@b)))
 (fn (a) x))

("with one rest-arg"
 (destructure/build 'args nil '(x) (fn (a b) `(fn ,a ,@b)))
 (fn args x))

("with one destructuring arg"
 (do (reset-uniq-counter)
      (destructure/build '((a b)) nil '(x) (fn (a b) `(fn ,a ,@b))))
 (fn (destructure-1) (with (a (nth 0 destructure-1) b (nth 1 destructure-1)) x)))

("with complex args"
 (do (reset-uniq-counter)
     (destructure/build '(a (b c) (d (e f)) g . h) nil '(x) (fn (a b) `(fn ,a ,@b))))
 (fn (a destructure-1 destructure-2 g . h)
     (with (d     (nth 0 destructure-2)
            (e f) (nth 1 destructure-2))
           (with (b (nth 0 destructure-1)
                  c (nth 1 destructure-1))
                 x)))))

(examples-for fun

("complete expansion, handles recursive destructures"
 (do (reset-uniq-counter)
     (pre-compile '(fun ((a (b c)) d . e) (do-the-thing a b c d e))))
 (fn (destructure-1 d . e)
     ((fn (a destructure-2)
          ((fn (b c)
               ((fn nil
                    (assign b (nth 0 destructure-2))
                    (assign c (nth 1 destructure-2))))
               ((fn nil
                    (assign a (nth 0 destructure-1))
                    ((fn (destructuring-assign-3)
                         (assign b (car destructuring-assign-3))
                         (assign c (car (cdr destructuring-assign-3))))
                     (nth 1 destructure-1))))
               (do-the-thing a b c d e))
           nil))
      nil)))

("nested improper arguments"
 (let (a (b c . d) e) (list "A" (list "B" "C" "D0" "D1" "D2") "E")
   (string-pieces a b c d e))
 "ABCD0D1D2E")

; a lot of ceremony here to suppress side-effects of compiling really crap code and just get the warnings
("warns about arg names shadowing macro names"
 (do (without-hooks 'warnings/new
                    λ(on-err nil
                             (apply macs.fun '((aif (and or) . when)
                                                ignore))))
     warnings/list)
 ((arg-shadows-macro "arg " when " shadows macro " when " in arg list " (aif (and or) . when) " and body " (ignore) )
  (arg-shadows-macro "arg "   or " shadows macro "   or " in arg list " (aif (and or) . when) " and body " (ignore) )
  (arg-shadows-macro "arg "  and " shadows macro "  and " in arg list " (aif (and or) . when) " and body " (ignore) )
  (arg-shadows-macro "arg "  aif " shadows macro "  aif " in arg list " (aif (and or) . when) " and body " (ignore) )))

("implicit in 'let and 'with"
 (with ((a b)       (list "h" "e")
        (c (d e f)) (list "l" (list "l" "o" " ")))
        (let (g (h (i j) k)) (list "w" (list "o" (list "r" "l") "d"))
          (string-pieces a b c d e f g h i j k)))
 "hello world"))

(examples-for =

("destructures LHS"
 (let a 1
   (let b 2
     (let c 3
       (let d 4
         (let e 5
           (= (a (b e) c . d) (list 'this '(that those) 'another 11 22 33))
           (list a b c d e))))))
 (this that another (11 22 33) those)))

(examples-for with

("destructures its args, also allows references to earlier args"
 (with ((a (b . c) d . e) '(1 (2 3 4 5) 6 7 8 9)
        x         a
        y         c
        z         (fn (n) (if (eq? n 1) 1 (* n (z (- n 1)))))
        g         (z 6))
       (list a b c d e x y g))
 (1 2 (3 4 5) 6 (7 8 9) 1 (3 4 5) 720)))