;; if 的基本语法
;; (if 条件 then表达式 else表达式)

(if (> 3 2)
    "3 大于 2"
    "3 不大于 2")
;; => "3 大于 2"

;; if 只有 then 分支时（Guile 扩展）
(if #t
    (display "真"))
;; 输出: 真
;; 返回值为 *unspecified*

;; if 是表达式，有返回值
(define x (if (> 10 5) 'yes 'no))
x  ; => yes

;; 嵌套 if
(define (describe-number n)
  (if (< n 0)
      "负数"
      (if (= n 0)
          "零"
          "正数")))

(describe-number -5)  ; => "负数"
(describe-number 0)   ; => "零"
(describe-number 3)   ; => "正数"

;; when / unless（Guile 扩展，更清晰的单分支）
(use-modules (ice-9 control))

(when (> 3 2)
  (display "条件为真")
  (newline))
;; 等价于 (if (> 3 2) (begin ...))

(unless (< 3 2)
  (display "条件为假"))
;; 等价于 (if (not (< 3 2)) (begin ...))

;; cond 的基本语法
;; (cond (条件1 表达式1)
;;       (条件2 表达式2)
;;       ...
;;       (else 默认表达式))

(define (day-type day)
  (cond
    ((memq day '(monday tuesday wednesday thursday friday))
     "工作日")
    ((memq day '(saturday sunday))
     "周末")
    (else "无效日期")))

(day-type 'monday)   ; => "工作日"
(day-type 'saturday) ; => "周末"
(day-type 'foo)      ; => "无效日期"

;; cond 中的多表达式（隐式 begin）
(define (grade score)
  (cond
    ((>= score 90) "优秀" "A")
    ((>= score 80) "良好" "B")
    ((>= score 70) "中等" "C")
    ((>= score 60) "及格" "D")
    (else "不及格" "F")))

;; Guile 扩展：cond => 语法（将结果绑定到变量）
(define (lookup key alist)
  (cond
    ((assq key alist) => cdr)  ; 如果找到，将结果传给 cdr
    (else #f)))

(lookup 'name '((name . "Alice") (age . 30)))  ; => "Alice"

;; => 的更多用法
(define (safe-divide a b)
  (cond
    ((zero? b) => (lambda (_) (error "除以零")))
    (else (/ a b))))

;; case 根据值进行匹配
;; (case 表达式
;;   ((值1 ...) 结果1)
;;   ((值2 ...) 结果2)
;;   ...
;;   (else 默认结果))

(define (season month)
  (case month
    ((3 4 5) "春天")
    ((6 7 8) "夏天")
    ((9 10 11) "秋天")
    ((12 1 2) "冬天")
    (else "无效月份")))

(season 3)   ; => "春天"
(season 7)   ; => "夏天"
(season 13)  ; => "无效月份"

;; case 使用 eqv? 进行比较
(define (type-name x)
  (case (if (number? x)
            'number
            (if (string? x) 'string 'other))
    ((number) "数字")
    ((string) "字符串")
    (else "其他类型")))

(type-name 42)     ; => "数字"
(type-name "hi")   ; => "字符串"
(type-name #t)     ; => "其他类型"

;; and —— 短路求值，返回最后一个真值或 #f
(and)                    ; => #t
(and 1)                  ; => 1
(and 1 2 3)              ; => 3
(and 1 #f 3)             ; => #f
(and 1 2 0)              ; => 0（0 是真值）

;; or —— 短路求值，返回第一个真值或 #f
(or)                      ; => #f
(or #f)                   ; => #f
(or #f 0 2 3)             ; => 0
(or #f #f #f)             ; => #f

;; 利用 and/or 作为控制流
(define (safe-divide a b)
  (and (not (zero? b))
       (/ a b)))

(safe-divide 10 2)   ; => 5
(safe-divide 10 0)   ; => #f

;; 使用 or 提供默认值
(define (greet name)
  (display (string-append "Hello, " (or name "World") "!")))

(greet "Alice")   ; => "Hello, Alice!"
(greet #f)        ; => "Hello, World!"

;; let 的基本语法
;; (let ((变量1 值1)
;;       (变量2 值2)
;;       ...)
;;   主体表达式)

(let ((x 10)
      (y 20))
  (+ x y))
;; => 30

;; let 是并行绑定（所有值在同一时间求值）
(let ((x 1)
      (y 2))
  ;; x 和 y 的值在绑定前已经确定
  ;; 此时 x 还不存在
  (+ x y))

;; 错误示例：let 中不能自引用
;; (let ((x 1)
;;       (y (+ x 1)))  ;; ERROR: x 还不存在
;;   (+ x y))

;; let* —— 顺序绑定（后面的绑定可以引用前面的）
(let* ((x 10)
       (y (+ x 5)))   ;; y 可以引用 x
  (+ x y))
;; => 25

;; let* 等价于嵌套的 let
(let ((x 10))
  (let ((y (+ x 5)))
    (+ x y)))

;; letrec —— 递归绑定（可以相互引用，常用于定义相互递归函数）
(letrec ((even? (lambda (n)
                  (if (= n 0) #t (odd? (- n 1)))))
         (odd? (lambda (n)
                 (if (= n 0) #f (even? (- n 1))))))
  (even? 10))
;; => #t

;; letrec*（Guile 3.0+）—— 顺序定义，支持向前引用
(letrec* ((x 10)
          (y (+ x 5))
          (z (* y 2)))
  z)
;; => 30

;; 接收多值返回
(use-modules (ice-9 receive))

;; 使用 receive
(receive (q r) (quotient/remainder 17 5)
  (format #t "~a 余 ~a~%" q r))
;; 输出: 3 余 2

;; 使用 call-with-values
(call-with-values
  (lambda () (values 1 2 3))
  (lambda (a b c)
    (+ a b c)))
;; => 6

;; let-values（SRFI-11）
(use-modules (srfi srfi-11))

(let-values (((q r) (quotient/remainder 17 5))
             ((a b) (values 10 20)))
  (+ q r a b))
;; => 35

;; do 的基本语法
;; (do ((变量1 初始值1 更新1)
;;      (变量2 初始值2 更新2)
;;      ...)
;;     (终止条件 返回值)
;;   循环体)

;; 求和
(do ((i 1 (+ i 1))
     (sum 0 (+ sum i)))
    ((> i 10) sum))
;; => 55

;; 打印三角形
(do ((i 1 (+ i 1)))
    ((> i 5))
  (do ((j 1 (+ j 1)))
      ((> j i))
    (display "*"))
  (newline))
;; 输出:
;; *
;; **
;; ***
;; ****
;; *****

;; 使用 do 构建列表
(do ((i 0 (+ i 1))
     (result '() (cons (* i i) result)))
    ((= i 5) (reverse result)))
;; => (0 1 4 9 16)

;; 命名 let 是更常用的循环方式
(let loop ((i 0) (acc '()))
  (if (= i 5)
      (reverse acc)
      (loop (+ i 1) (cons (* i i) acc))))
;; => (0 1 4 9 16)

;; 实际应用：字符串处理
(define (count-chars str pred)
  (let loop ((chars (string->list str))
             (count 0))
    (if (null? chars)
        count
        (loop (cdr chars)
              (if (pred (car chars))
                  (+ count 1)
                  count)))))

(count-chars "Hello World" char-whitespace?)  ; => 1
(count-chars "abc123" char-numeric?)           ; => 3

;; 通用递归模式
(define (process-list lst)
  (let loop ((rest lst)
             (result '()))
    (if (null? rest)
        (reverse result)
        (loop (cdr rest)
              (cons (process-item (car rest))
                    result)))))

;; 更复杂的递归：带累加器和状态
(define (fold-with-index f init lst)
  (let loop ((rest lst)
             (index 0)
             (acc init))
    (if (null? rest)
        acc
        (loop (cdr rest)
              (+ index 1)
              (f index (car rest) acc)))))

(fold-with-index
  (lambda (i item acc)
    (cons (cons i item) acc))
  '()
  '(a b c d))
;; => ((3 . d) (2 . c) (1 . b) (0 . a))

;; delay 创建一个 promise（延迟求值）
;; force 求值一个 promise

(define lazy-value
  (delay
    (display "计算中...")
    (newline)
    42))

;; 此时还没有执行 "计算中..."
(display "准备好了\n")
;; 输出: 准备好了

(force lazy-value)
;; 输出: 计算中...
;;      42

(force lazy-value)
;; 不再输出，直接返回 42（promise 只计算一次）

;; 实际应用：惰性序列
(define (make-lazy-range start end)
  (delay
    (if (>= start end)
        '()
        (cons start
              (make-lazy-range (+ start 1) end)))))

(define (lazy-ref lazy-list n)
  (let ((lst (force lazy-list)))
    (if (null? lst)
        (error "索引越界")
        (if (= n 0)
            (car lst)
            (lazy-ref (cdr lst) (- n 1))))))

(lazy-ref (make-lazy-range 0 1000000) 999)
;; => 999（不会创建百万级列表）

;; 使用 SRFI-41 实现惰性流
(use-modules (srfi srfi-41))

;; 定义流
(define-stream (integers-from n)
  (stream-cons n (integers-from (+ n 1))))

(define naturals (integers-from 0))

;; 取前 10 个
(stream->list (stream-take 10 naturals))
;; => (0 1 2 3 4 5 6 7 8 9)

;; 流操作
(stream-ref naturals 100)  ; => 100

;; 斐波那契流
(define fibs
  (stream-cons 0
    (stream-cons 1
      (stream-map + fibs (stream-cdr fibs)))))

(stream->list (stream-take 10 fibs))
;; => (0 1 1 2 3 5 8 13 21 34)

;; 基本异常处理
(use-modules (ice-9 exceptions))

;; 抛出异常
(throw 'my-error "出了问题" '(details here))

;; 捕获异常
(guard (exn
         ((eq? (car exn) 'my-error)
          (format #t "捕获错误: ~a~%" (caddr exn)))
         (else
          (format #t "未知错误: ~a~%" exn)))
  (throw 'my-error "出了问题" '(details here)))
;; 输出: 捕获错误: (details here)

;; 更现代的方式
(with-exception-handler
  (lambda (exn)
    (format #t "异常: ~a~%" exn)
    'handled)
  (lambda ()
    (+ 1 (throw 'error "测试"))))
;; 输出: 异常: (error 测试)
;; => 'handled

;; 错误处理实用函数
(define (safe-read-file filename)
  (catch #t
    (lambda ()
      (call-with-input-file filename
        (lambda (port)
          (read port))))
    (lambda (key . args)
      (format #t "读取 ~a 失败: ~a~%" filename key)
      #f)))

;; catch 的语法
;; (catch 键 处理器 thunk [handler])

;; 简单的错误处理
(catch 'division-by-zero
  (lambda ()
    (/ 1 0))
  (lambda (key . args)
    (display "不能除以零\n")))

;; 多层 catch
(catch 'outer-error
  (lambda ()
    (catch 'inner-error
      (lambda ()
        (throw 'inner-error "内部错误"))
      (lambda (key . args)
        (display "内部处理\n")
        (throw 'outer-error "传递到外层"))))
  (lambda (key . args)
    (format #t "外层捕获: ~a~%" (car args))))

;; 参数（dynamic variables）是 Guile 的动态绑定机制
(define current-user (make-parameter "anonymous"))

;; 使用 parameterize 临时修改值
(parameterize ((current-user "admin"))
  (format #t "当前用户: ~a~%" (current-user)))
;; 输出: 当前用户: admin

(current-user)  ; => "anonymous"（恢复原值）

;; 嵌套 parameterize
(parameterize ((current-user "admin"))
  (format #t "外层: ~a~%" (current-user))
  (parameterize ((current-user "root"))
    (format #t "内层: ~a~%" (current-user)))
  (format #t "外层: ~a~%" (current-user)))
;; 输出:
;; 外层: admin
;; 内层: root
;; 外层: admin

;; 实际应用：配置管理
(define debug-mode (make-parameter #f))
(define log-level (make-parameter 'info))

(define (debug-log msg)
  (when (debug-mode)
    (format #t "[DEBUG] ~a~%" msg)))

(parameterize ((debug-mode #t))
  (debug-log "调试信息"))
;; 输出: [DEBUG] 调试信息

;; 规则：递归调用必须是表达式的"尾位置"

;; ✅ 尾调用优化生效
(define (sum-tail lst)
  (let loop ((rest lst) (acc 0))
    (if (null? rest)
        acc
        (loop (cdr rest) (+ (car rest) acc)))))

;; ❌ 不是尾调用
(define (sum-bad lst)
  (if (null? lst)
      0
      (+ (car lst) (sum-bad (cdr lst)))))
;; (sum-bad (cdr lst)) 不在尾位置

;; ✅ 使用 call/cc 可以保持尾调用特性
;; Guile 的 CPS 引擎保证了尾调用优化

;; 测试大列表
(sum-tail (iota 100000))  ; => 4999950000（不会栈溢出）
;; (sum-bad (iota 100000)) ;; 可能栈溢出

;; 尾位置示例
;; 以下位置是尾位置：
;; 1. 函数体的最后一个表达式
;; 2. if 的 then 和 else 分支
;; 3. cond 的每个子句体
;; 4. let/let*/letrec 的最后一个表达式
;; 5. begin 的最后一个表达式
;; 6. and/or 的最后一个操作数
;; 7. case 的每个子句体

;; 复杂示例
(define (process lst)
  (let loop ((rest lst) (acc '()))
    (cond
      ((null? rest) (reverse acc))  ; 尾位置
      ((even? (car rest))
       (loop (cdr rest)             ; 尾位置
             (cons (car rest) acc)))
      (else
       (loop (cdr rest) acc)))))    ; 尾位置

;; 使用闭包实现有限状态机
(define (make-door-fsm)
  (let ((state 'closed))
    (lambda (action)
      (case state
        ((closed)
         (case action
           ((open) (set! state 'open) "门打开了")
           ((lock) (set! state 'locked) "门锁上了")
           (else "当前状态: 关闭，只能开/锁")))
        ((open)
         (case action
           ((close) (set! state 'closed) "门关上了")
           (else "当前状态: 打开，只能关闭")))
        ((locked)
         (case action
           ((unlock) (set! state 'closed) "门解锁了")
           (else "当前状态: 锁定，只能解锁")))))))

(define door (make-door-fsm))
(door 'open)    ; => "门打开了"
(door 'close)   ; => "门关上了"
(door 'lock)    ; => "门锁上了"
(door 'open)    ; => "当前状态: 锁定，只能解锁"

;; 递归下降配置解析
(define (parse-config tokens)
  (let loop ((tokens tokens)
             (result '()))
    (cond
      ((null? tokens) (reverse result))
      ((eq? (car tokens) 'section)
       (loop (cddr tokens)
             (cons (cons (cadr tokens) '()) result)))
      ((eq? (car tokens) 'key)
       (loop (cdddr tokens)
             (if (null? result)
                 (error "键值在节外")
                 (acons (cadr tokens)
                        (caddr tokens)
                        (car result)
                        (cdr result)))))
      (else (error "未知 token")))))