;;
;; absurd contrived exaggerated example to test that macros that generate
;; macros that generate macros that generate expressions are likely to work
;;
;; may you never need to do this in real life
;;
(mac make-make-op (opname op)
  `(mac ,opname (name n . body)
     `(mac ,name (x)
        `(,',',op ,,n ,x))))

(make-make-op make-mult *)
(make-make-op make-plus +)

(make-mult *five 5)
(make-mult *seven 7)
(make-mult *eleven 11)

(make-plus +five 5)
(make-plus +seven 7)
(make-plus +eleven 11)

;;
;; another contrived example to check deeply nested lexical scoping
;;
(let test-a0 "a0"
  (def test-foo (f0 f1)
    (with (w0 "w0" w1 "w1" w2 "w2" w3 "w3")
          (let f (fn (x0) (joinstr " " test-a0 x0 f0 x0 f1))
            (map f (list w0 w1 w2 w3))))))

(examples-for map
  ("maps a function over a list of numbers"
   (map (fn (x) (* x x)) '(1 2 3))
   (1 4 9))

  ("maps a string join function over a list of strings"
   (test-foo "x" "y")
   ("a0 w0 x w0 y" "a0 w1 x w1 y" "a0 w2 x w2 y" "a0 w3 x w3 y"))

  (suite "mapx"
         ("provides a convenient simplification for 'map"
          (mapx '(1 2 3 4) n (* n 2))
          (2 4 6 8))))

(examples-for reduce
  ("it applies a function cumulatively over a list"
   (reduce + '(1 2 3))
   6))

(examples-for bang-syntax
  ("expansion"
   (pre-compile '(!eq? a b))
   ((fn args (no (apply eq? args))) a b))

  ("bang-syntax for 'eq?"
   (!eq? 1 2)
   t)

  ("bang-syntax for 'caris"
   (!caris 'foo '(foo bar))
   nil)

  ("bang-syntax for 'caris"
   (!caris 'foo '(zozo foo bar))
   t))

(examples-for ampersand-syntax
  ("defines a hash-lookup function"
   (pre-compile '&first)
   (fn (obj) (hash-get obj (quote first))))

  ("defines a hash-lookup function with a dot-syntax arg"
   (pre-compile '&teacher.address.city)
   (fn (obj) (hash-get (hash-get (hash-get obj (quote teacher)) (quote address)) (quote city))) ))

(examples-for colon-syntax
  ("used for composition"
   (pre-compile '(no:eq? a b))
   ((fn args (no (apply eq? args))) a b))

  ("used for composition"
   (pre-compile '(x:y a b))
   ((fn args (x (apply y args))) a b))

  ("special combination with bang"
   (pre-compile '(!x:y a b))
   ((fn args (no (x (apply y args)))) a b))

  ("precedence over ampersand-syntax"
   (pre-compile '(&attr:func a b))
   ((fn args ((fn (obj) (hash-get obj (quote attr))) (apply func args))) a b)))

(examples-for let
  ("expands 'let"
   (do
       (def x+3*z (x y)
         (let y 3
           (fn (z) (* (+ x y) z))))
       ((x+3*z 2 99) 5))
   25))

(examples-for and
  ("expands 'and"
   (pre-compile '(and a b c))
   (cond a (cond b c))))

(examples-for or
  ("expands 'or"
   (do (reset-uniq-counter)
       (pre-compile '(or a b c)))
   ((fn (ora-1)
        (cond ora-1
              ora-1
              ((fn (ora-2)
                   (cond ora-2
                         ora-2
                         ((fn (ora-3)
                              (cond ora-3
                                    ora-3
                                    nil)) c))) b))) a)))

(examples-for w/uniq
  ("w/uniq provides unique variables for macro expansion"
   (do (reset-uniq-counter)
       (pre-compile '(w/uniq a foo)))
   ((fn (a) foo) (uniq 'a))))

(examples-for build-keyword-args
  ("takes a list of lists and returns the list with the first item of each sublist quoted"
   (build-keyword-args '( (a 1) (b c) (d e "f" 22) ))
   ((list 'a 1) (list 'b c) (list 'd e "f" 22))))

(examples-for mac
  ("make-plus example generates a plus-seven expression"
   (+seven 6)
   13)
  ("make-mult example generates a multiply-by-seven expression"
   (*seven 6)
   42)
  ("make-mult example generates a multiply-by-eleven expression"
   (*eleven 20)
   220)
  ("make-make example expressions can be nested"
   (*eleven (*five (+seven 2)))
   495))