;; Macro System Examples
;; Demonstrates defmacro, quasiquote, unquote, and macro expansion

(import assert :refer :all)
(import binding :refer :all)
(import control :refer :all)
(import display :refer :all)
(import looping :refer :all)
(import threading :refer :all)

;; ============================================================================
;; Simple Macros
;; ============================================================================

(println "=== Simple Macros ===\n")

;; A macro that doubles its argument
;;' @description Multiply x by 2 at macro expansion time.
(defmacro double (x)
  `(* 2 ,x))

(assert-equal 10 (double 5))
(println (string-concat "(double 5) = " (double 5)))
(assert-equal 6 (double (+ 1 2)))
(println (string-concat "(double (+ 1 2)) = " (double (+ 1 2))))

;; A macro that creates a variable with a default value
;;' @description Define a variable with a value.
(defmacro defvar (name value)
  `(define ,name ,value))

(defvar x 42)
(assert-equal 42 x)
(println (string-concat "x = " x))

;; ============================================================================
;; Macros with Multiple Expressions
;; ============================================================================

(println "\n=== Macros with Multiple Expressions ===\n")

;; A macro that executes multiple forms and returns the last
;;' @description Evaluate forms in order and return the last.
(defmacro progn (first . rest)
  `(begin ,first ,@rest))

(println "Using progn:")
(progn
  (println "First")
  (println "Second")
  (println "Third"))

;; ============================================================================
;; Control Flow Macros
;; ============================================================================

(println "\n=== Control Flow Macros ===\n")

;; Custom when-not macro
;;' @description Evaluate body when test is falsy.
(defmacro when-not (test . body)
  `(if (not ,test)
       (begin ,@body)
       #nil))

(when-not #f
  (println "This should print"))

(when-not #t
  (println "This should not print"))

;; A do-times macro
;;' @description Repeat body n times.
(defmacro do-times (n . body)
  (let ((counter (gensym "counter")))
    `(let ((,counter 0))
       (while (< ,counter ,n)
         (begin ,@body)
         (set! ,counter (+ ,counter 1))))))

(println "do-times example:")
(define count 0)
(do-times 5
  (set! count (+ count 1))
  (println (string-concat "Count: " count)))
(assert-equal 5 count)

;; ============================================================================
;; Macro Expansion Examples
;; ============================================================================

(println "\n=== Macro Expansion ===\n")

(println "Original: (when (> 5 3) (println \"yes\"))")
(println "Expanded:")
(println (macroexpand-1 '(when (> 5 3) (println "yes"))))

(println "\nOriginal: (let ((x 1)) (+ x 2))")
(println "Expanded:")
(println (macroexpand-1 '(let ((x 1)) (+ x 2))))

;; ============================================================================
;; Anaphoric Macros (macros that capture a name)
;; ============================================================================

(println "\n=== Anaphoric Macros ===\n")

;; An anaphoric if that binds result to 'it'
;;' @description Bind test result to it and select then/alt.
(defmacro aif (test then alt)
  `(let ((it ,test))
     (if it ,(capture 'it then) ,(capture 'it alt))))

(println "Anaphoric if example:")
(aif (+ 2 3)
     (println (string-concat "Result is: " it))
     (println "No result"))

;; ============================================================================
;; Building DSLs with Macros
;; ============================================================================

(println "\n=== Simple DSL Example ===\n")

;; A macro for defining test cases
;;' @description Define and run a simple test case.
(defmacro deftest (name . body)
  `(begin
     (println (string-concat "Running test: " (quote ,name)))
     ,@body
     (println "Test passed!\n")))

(deftest addition-works
  (assert (= (+ 1 2) 3) "1 + 2 should equal 3")
  (assert (= (+ 5 5) 10) "5 + 5 should equal 10"))

(deftest string-operations
  (assert (= (string-concat "hello" " " "world") "hello world")
          "String concatenation works"))

;; ============================================================================
;; Hygiene and explicit capture
;; ============================================================================

(println "\n=== Hygiene and Capture ===\n")

;; Automatic hygiene (no gensym needed)
;;' @description Swap two bindings using a temporary.
(defmacro swap (a b)
  `(let ((temp ,a))
     (set! ,a ,b)
     (set! ,b temp)))

(println "Demonstrating gensym:")
(println (string-concat "Generated symbol 1: " (gensym)))
(println (string-concat "Generated symbol 2: " (gensym)))
(println (string-concat "Generated symbol with prefix: " (gensym "my-prefix")))

;; ============================================================================
;; Quasiquote Examples
;; ============================================================================

(println "\n=== Quasiquote Examples ===\n")

(define x 10)
(define y 20)

(println "Without quasiquote:")
(println (list '+ 1 2))

(println "\nWith quasiquote and unquote:")
(println `(+ ,x ,y))

(println "\nWith unquote-splicing:")
(define nums (list 1 2 3))
(println `(+ ,@nums))  ; Should expand to (+ 1 2 3)

;; ============================================================================
;; Recursive Macros
;; ============================================================================

(println "\n=== Recursive Macro Example ===\n")

;; A macro that chains function calls
;;' @description Thread value through forms (first argument).
(defmacro -> (value . forms)
  (if (null? forms)
      value
      (let ((first-form (car forms))
            (rest-forms (cdr forms)))
        (if (list-or-pair? first-form)
            `(-> (,(car first-form) ,value ,@(cdr first-form)) ,@rest-forms)
            `(-> (,first-form ,value) ,@rest-forms)))))

(println "Threading macro example:")
(assert-equal 15 (-> 5
                     (+ 3)
                     (* 2)
                     (- 1)))
(println (string-concat "Result: " (-> 5
                              (+ 3)
                              (* 2)
                              (- 1))))  ; ((5 + 3) * 2) - 1 = 15

;; ============================================================================
;; Compile-Time Computation
;; ============================================================================

(println "\n=== Compile-Time Computation ===\n")

;; A macro that computes at macro expansion time
;;' @description Compute the product of a and b at expand time.
(defmacro const-multiply (a b)
  (let ((result (* a b)))
    `(quote ,result)))

(assert-equal 42 (const-multiply 6 7))
(println (string-concat "(const-multiply 6 7) = " (const-multiply 6 7)))
(println "This multiplication happened at macro expansion time!")

(define threading-result (-> 5 (+ 3) (* 2) (- 1)))
(define aif-result (aif (+ 2 3) it #nil))
(assert-equal 15 threading-result)
(assert-equal 5 aif-result)

(println "\nExample complete!")
