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

(register-test
 '(suite "Boot Tests"
         (suite "hashtables"
                ("build a hash table from brace-list syntax"
                 (let hsh { foo 1 bar 2 }
                      (list 'foo hsh.foo 'bar hsh.bar))
                 (foo 1 bar 2))

                ("single-item brace list is just the thing itself"
                 (let zi 10 "finds the ~{zi}th item")
                 "finds the 10th item")

                ("unquotes hash keys"
                 (with (zi 'foo chi 'bar yi 'grr)
                      (let hsh { ,zi 10 ,chi 11 ,yi 12 }
                           (list zi hsh.foo chi hsh.bar yi hsh.grr)))
                 (foo 10 bar 11 grr 12))

                ("allows literal and invocation hash keys"
                 (with (zi "hello" chi "world")
                      (let hsh { (joinstr " " zi chi) 10 "yesterday" 11 }
                           (list "hello world" (hash-get hsh "hello world") "yesterday" (hash-get hsh "yesterday"))))
                 ("hello world" 10 "yesterday" 11)))

         (suite "strings"
                ("length"
                 (len "foo-bar")
                 7))

         (suite "list management"
                ("'pair breaks a list into pairs"
                 (pairs '(1 a 2 b 3 c))
                 ((1 a) (2 b) (3 c)))

                ("'rev reverses a list"
                 (rev '(a b c))
                 (c b a))

                ("'rev handles nil"
                 (rev nil)
                 nil)

                ("'rev doesn't recurse"
                 (rev '(a b (c d e) f g))
                 (g f (c d e) b a))

                ("joins elements into a string"
                 (joinstr "" '("foo" "bar" "bax"))
                 "foobarbax")

                ("joins separate elements into a string"
                 (joinstr "/" "foo" "bar" "bax")
                 "foo/bar/bax")

                ("joins a single thing"
                 (joinstr "/" "foo")
                 "foo")

                ("joins nested and separate elements into a string"
                 (joinstr "/" "foo" "bar" '(twiddle diddle) "bax")
                 "foo/bar/twiddle/diddle/bax")

                ("joins elements into a string"
                 (joinstr " - " '(1 2 3))
                 "1 - 2 - 3")

                ("'flatten returns a flat list of things"
                 (flatten '((poo (x) (* x x)) (1 2 3)))
                 (poo x * x x 1 2 3)))

         (suite "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 "pre-compile"
                (suite "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))

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

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

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

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

                (suite "quasiquote"
                       ("same as quote for standalone item"
                        `a
                        a)
                       ("same as quote for standalone list"
                        `(a b c)
                        (a b c))
                       ("substitutes single variables"
                        (let b 10 `(a ,b c))
                        (a 10 c))
                       ("substitutes a list"
                        (let b '(1 2 3) `(a ,@b c))
                        (a 1 2 3 c))
                       ("substitutes a list at the end of a given list"
                        (let b '(1 2 3) `(a ,b ,@b))
                        (a (1 2 3) 1 2 3))
                       ("more complicated substitution example"
                        (with (d '(1 2 3) g '(x y z)) `(a (b c ,d (e f ,@g))))
                        (a (b c (1 2 3) (e f x y z))))
                       ("peeks inside nested quotes"
                        `(a b '(c ,(+ 1 2)))
                        (a b '(c 3)))
                       ("handles nested unquote-splicing"
                        ``(a ,,@(list '+ 1 2) b)
                        `((a ,(+ 1 2) b)))
                       ("returns nested quasiquotes"
                        `(a b `(c d ,(+ 1 2) ,,(+ 3 4)))
                        (a b `(c d ,(+ 1 2) ,7)))))

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

         (suite "make-macros can create macros"
                ("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))))