;; ;; 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))

("applies the function to a singleton argument"
 (map (fn (x) (* x x)) 19)
 361)

("preserves dotted lists"
 (map (fn (x) (* x x)) '(1 2 3 4 . 5))
 (1 4 9 16 . 25))

("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 a tricky '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
                       (c))) (b)))) (a)))

("expands a simple symbol-only 'or"
 (pre-compile '(or a b c))
 (cond a a (cond b b c))))

(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))