;; 函数：参数在调用前已求值
(define (my-if test then else)
  (cond (test then)
        (else else)))
;; 问题：then 和 else 都会被求值！
(my-if #t (display "yes") (display "no"))
;; 输出: yesno（两个分支都执行了）

;; 宏：可以选择性地展开
;; 宏定义见下节

;; syntax-rules 的基本结构
;; (syntax-rules (字面量...)
;;   (模式 模板)
;;   (模式 模板)
;;   ...)

;; 模式匹配：_ 匹配任何内容
(define-syntax my-when
  (syntax-rules ()
    ((_ test body ...)
     (if test (begin body ...)))))

(my-when (> 3 2)
  (display "3 大于 2")
  (newline))
;; 展开为: (if (> 3 2) (begin (display "3 大于 2") (newline)))

;; ... 表示"零个或多个"
(define-syntax my-list
  (syntax-rules ()
    ((_ item ...)
     (list item ...))))

(my-list 1 2 3 4)
;; 展开为: (list 1 2 3 4)

;; 多组省略号
(define-syntax my-pairs
  (syntax-rules ()
    ((_ (key val) ...)
     (list (cons key val) ...))))

(my-pairs (a 1) (b 2) (c 3))
;; 展开为: (list (cons 'a 1) (cons 'b 2) (cons 'c 3))
;; 注意：symbol 在这里不会自动引号化，需要额外处理

;; 字面量匹配
(define-syntax my-cond
  (syntax-rules (else)
    ((_ (else body ...))
     (begin body ...))
    ((_ (test body ...) rest ...)
     (if test
         (begin body ...)
         (my-cond rest ...)))))

(my-cond
  ((> 3 5) "大于")
  ((= 3 5) "等于")
  (else "小于"))

;; 卫生宏的关键特性
(define-syntax swap!
  (syntax-rules ()
    ((_ a b)
     (let ((temp a))    ; temp 不会与外部的 temp 冲突
       (set! a b)
       (set! b temp)))))

(define temp 100)
(define x 1)
(define y 2)

(swap! x y)
;; x => 2, y => 1, temp => 100（temp 不受影响）

;; 非卫生宏的问题（Common Lisp 风格）
;; 如果 temp 不是卫生的，上面的 temp 100 会被覆盖

;; 对比：使用 gensym 确保唯一性（了解原理）
;; (define-syntax swap-unsafe
;;   (syntax-rules ()
;;     ((_ a b)
;;      (let ((t a))    ; t 可能与外部冲突！
;;        (set! a b)
;;        (set! b t)))))

;; 带多子句的宏
(define-syntax my-let
  (syntax-rules ()
    ;; 简单 let
    ((_ ((var val) ...) body ...)
     ((lambda (var ...) body ...) val ...))
    ;; 命名 let
    ((_ name ((var val) ...) body ...)
     ((letrec ((name (lambda (var ...) body ...)))
        name)
      val ...))))

;; 使用简单 let
(my-let ((x 1) (y 2))
  (+ x y))
;; => 3

;; 使用命名 let
(my-let loop ((i 0) (acc 0))
  (if (> i 10)
      acc
      (loop (+ i 1) (+ acc i))))
;; => 55

;; 递归展开的宏
(define-syntax or-mine
  (syntax-rules ()
    ((_) #f)
    ((_ e) e)
    ((_ e1 e2 ...)
     (let ((t e1))
       (if t t (or-mine e2 ...))))))

(or-mine #f #f 3 #f)
;; => 3

;; 条件编译宏
(define-syntax define-with-log
  (syntax-rules ()
    ((_ (name args ...) body ...)
     (define (name args ...)
       (format #t "调用 ~a~%" 'name)
       body ...))))

(define-with-log (add a b)
  (+ a b))

(add 3 4)
;; 输出: 调用 add
;; => 7

;; 使用字面量集（literal sets）精确控制匹配
(define-syntax my-case
  (syntax-rules (else =>)
    ((_ expr)
     #f)
    ((_ expr (else body ...))
     (begin body ...))
    ((_ expr (vals => func) rest ...)
     (if (memv expr 'vals)
         (func expr)
         (my-case expr rest ...)))
    ((_ expr (vals body ...) rest ...)
     (if (memv expr 'vals)
         (begin body ...)
         (my-case expr rest ...)))))

(my-case 2
  ((1 3 5) "奇数")
  ((2 4 6) "偶数" "是偶数")
  (else "其他"))
;; => "偶数" "是偶数"（返回最后一个表达式的结果）

;; 1. 表达式计时宏
(define-syntax time-it
  (syntax-rules ()
    ((_ label body ...)
     (let ((start (get-internal-real-time)))
       (let ((result (begin body ...)))
         (let ((end (get-internal-real-time)))
           (format #t "[~a] 耗时: ~a ms~%"
                   label
                   (/ (* (- end start) 1000)
                      internal-time-units-per-second))
           result))))))

(time-it "计算"
  (apply + (iota 1000000)))
;; 输出: [计算] 耗时: XX ms
;; => 499999500000

;; 2. 断言宏
(define-syntax assert
  (syntax-rules ()
    ((_ expr)
     (unless expr
       (error "断言失败:" 'expr)))
    ((_ expr msg)
     (unless expr
       (error msg 'expr)))))

(define x 5)
(assert (> x 0))     ; 通过
;; (assert (< x 0))  ; => ERROR: 断言失败: (< x 0)

;; 3. 解构绑定宏
(define-syntax let-alist
  (syntax-rules ()
    ((_ alist ((key var) ...) body ...)
     (let ((var (assq-ref alist 'key)) ...)
       body ...))))

(define config '((host . "localhost") (port . 8080) (debug . #t)))
(let-alist config ((host h) (port p) (debug d))
  (format #t "~a:~a debug=~a~%" h p d))
;; 输出: localhost:8080 debug=#t

;; 4. 组合子宏
(define-syntax compose-macros
  (syntax-rules ()
    ((_ f g)
     (syntax-rules ()
       ((_ args ...)
        (f (g args ...)))))))

;; 5. 条件定义宏
(define-syntax define-if-available
  (syntax-rules ()
    ((_ name module-ref fallback)
     (define name
       (catch #t
         (lambda ()
           (resolve-interface module-ref))
         (lambda _ fallback))))))

;; 在宏展开期进行计算
(define-syntax compile-time-constant
  (syntax-rules ()
    ((_ expr)
     (let-syntax ((val (syntax-rules ()
                         ((_) expr))))
       (val)))))

;; 实际应用：编译期字符串拼接
(define-syntax string-join-compile
  (syntax-rules ()
    ((_ sep s ...)
     (string-append s ...))))

;; 注：Guile 的 syntax-rules 能力有限，
;; 复杂编译期计算需要 syntax-case 或 define-macro

;; define-macro（非卫生，需谨慎使用）
(define-macro (my-unless test . body)
  `(if (not ,test)
       (begin ,@body)))

(my-unless (< 3 2)
  (display "3 不小于 2")
  (newline))
;; 展开为: (if (not (< 3 2)) (begin (display "3 不小于 2") (newline)))

;; 对比 syntax-rules 和 define-macro

;; syntax-rules 版本（卫生）
(define-syntax s-unless
  (syntax-rules ()
    ((_ test body ...)
     (if (not test) (begin body ...)))))

;; define-macro 版本（非卫生，但更灵活）
(define-macro (m-unless test . body)
  `(if (not ,test)
       (begin ,@body)))

;; 非卫生宏的风险
(define-macro (dangerous-swap! a b)
  `(let ((temp ,a))
     (set! ,a ,b)
     (set! ,b temp)))

;; 如果外部有 temp 变量会出问题
(define temp 100)
(define p 1)
(define q 2)
(dangerous-swap! p q)
;; temp 可能被覆盖！

(use-modules (ice-9 syncase))

;; syntax-case 允许在模式匹配中使用任意谓词
(define-syntax my-letrec
  (lambda (stx)
    (syntax-case stx ()
      ((_ ((var init) ...) body ...)
       (with-syntax ((tmp (generate-temporaries #'(var ...))))
         #'((lambda (var ...)
              (let ((tmp init) ...)
                (set! var tmp) ...
                body ...))
            (void) ...))))))

;; 带谓词的模式匹配
(define-syntax my-define
  (lambda (stx)
    (syntax-case stx ()
      ((_ name value)
       (identifier? #'name)
       #'(define name value))
      ((_ (name args ...) body ...)
       (identifier? #'name)
       #'(define (name args ...) body ...)))))

;; syntax-case 的优势：可以进行任意检查
(define-syntax check-type
  (lambda (stx)
    (syntax-case stx (integer string)
      ((_ integer expr)
       #'(let ((val expr))
           (unless (integer? val)
             (error "期望整数" val))
           val))
      ((_ string expr)
       #'(let ((val expr))
           (unless (string? val)
             (error "期望字符串" val))
           val)))))

(check-type integer 42)    ; => 42
;; (check-type integer "hi") ; => ERROR: 期望整数

;; 查看宏展开结果
(use-modules (ice-9 pretty-print))

;; 使用 macroexpand（Guile 中通过 Ice-9 提供）
(use-modules (system syntax internal))

;; 或者简单地在 REPL 中使用 ,pp
;; scheme@(guile-user)> ,pp (syntax->datum (expand '(my-when #t (display "hi"))))

;; 手动展开
(define-syntax test-macro
  (syntax-rules ()
    ((_ x) (+ x 1))))

;; 调试技巧：用 quote 返回宏的输出
(define-syntax debug-macro
  (syntax-rules ()
    ((_ x)
     (quote (+ x 1)))))  ; 返回代码而非执行结果

(debug-macro 5)  ; => (+ x 1)

;; 用宏创建 HTML DSL
(define-syntax html
  (syntax-rules (div p span h1 h2 ul li a)
    ((_ (div attrs ... body ...))
     (string-append "<div" (format-attrs attrs ...) ">"
                    (html body ...) ... "</div>"))
    ((_ (p body ...))
     (string-append "<p>" (html body ...) ... "</p>"))
    ((_ (h1 body ...))
     (string-append "<h1>" (html body ...) ... "</h1>"))
    ((_ text)
     (if (string? text) text (format #f "~a" text)))))

;; 实用的配置 DSL
(define-syntax define-config
  (syntax-rules ()
    ((_ name (key default) ...)
     (define name
       (let ((ht (make-hash-table)))
         (hash-set! ht 'key default) ...
         (lambda (msg . args)
           (case msg
             ((get) (hash-ref ht (car args)))
             ((set!) (hash-set! ht (car args) (cadr args)))
             ((all) ht))))))))

(define-config my-app-config
  (host "localhost")
  (port 8080)
  (debug #f))

(my-app-config 'get 'host)  ; => "localhost"
(my-app-config 'set! 'port 3000)
(my-app-config 'get 'port)  ; => 3000

;; 简易测试框架
(define test-count 0)
(define pass-count 0)

(define-syntax test-case
  (syntax-rules ()
    ((_ name expr expected)
     (begin
       (set! test-count (+ test-count 1))
       (let ((result expr))
         (if (equal? result expected)
             (begin
               (set! pass-count (+ pass-count 1))
               (format #t "  ✓ ~a~%" name))
             (format #t "  ✗ ~a: 期望 ~a, 得到 ~a~%"
                     name expected result)))))))

(define-syntax test-suite
  (syntax-rules ()
    ((_ name test ...)
     (begin
       (format #t "=== ~a ===~%" name)
       test ...
       (format #t "结果: ~a/~a 通过~%"
               pass-count test-count)
       (set! test-count 0)
       (set! pass-count 0)))))

(test-suite "算术测试"
  (test-case "加法" (+ 1 2) 3)
  (test-case "乘法" (* 3 4) 12)
  (test-case "减法" (- 10 3) 7))
;; === 算术测试 ===
;;   ✓ 加法
;;   ✓ 乘法
;;   ✓ 减法
;; 结果: 3/3 通过