;; R5RS 核心特性演示

;; 1. 词法作用域 (lexical scoping)
(define x 10)
(let ((x 20))
  x)  ; => 20
x    ; => 10（外层绑定不受影响）

;; 2. 一等函数 (first-class functions)
(define (apply-twice f x)
  (f (f x)))
(apply-twice (lambda (n) (* n 2)) 3)  ; => 12

;; 3. 尾递归优化 (tail-call optimization)
(define (factorial n acc)
  (if (<= n 1)
      acc
      (factorial (- n 1) (* n acc))))
(factorial 10 1)  ; => 3628800

;; 4. 连续 (continuations) —— Guile 通过 call/cc 支持
(+ 1 (call/cc
       (lambda (k)
         (+ 2 (k 3)))))  ; => 4

;; R6RS 风格的库定义（Guile 中通过模块实现类似功能）
;; 在 Guile 中，我们使用 define-module 替代 R6RS 的 library

(define-module (my-math basic)
  #:export (square cube))

(define (square x) (* x x))
(define (cube x) (* x x x))

;; R7RS 特性示例

;; 定义记录类型 (record type)
;; Guile 通过 srfi-9 提供类似功能
(use-modules (srfi srfi-9))

(define-record-type <point>
  (make-point x y)
  point?
  (x point-x)
  (y point-y))

(define p (make-point 3 4))
(point-x p)  ; => 3
(point-y p)  ; => 4

;; 命名 let（Guile 原生支持）
(let loop ((i 0) (acc '()))
  (if (= i 5)
      (reverse acc)
      (loop (+ i 1) (cons i acc))))
; => (0 1 2 3 4)

;; 1. 字符串处理（SRFI-13）
(use-modules (srfi srfi-13))

(string-join '("Hello" "Guile" "World") "-")
; => "Hello-Guile-World"

(string-contains "Hello Guile World" "Guile")
; => 6

;; 2. 正则表达式
(use-modules (ice-9 regex))

(define m (string-match "([0-9]+)\\.([0-9]+)" "version 3.0.5"))
(match:substring m 0)  ; => "3.0"
(match:substring m 1)  ; => "3"
(match:substring m 2)  ; => "0"

;; 3. 哈希表
(define ht (make-hash-table))
(hash-set! ht 'name "Guile")
(hash-set! ht 'version 3)
(hash-ref ht 'name)    ; => "Guile"
(hash-ref ht 'version) ; => 3

;; 4. 进程调用
(use-modules (ice-9 popen))
(use-modules (ice-9 textual-ports))

(let* ((port (open-input-pipe "uname -a"))
       (output (get-string-all port)))
  (close-pipe port)
  (display output))

;; SRFI 使用示例

;; SRFI-1: 列表操作
(use-modules (srfi srfi-1))

(filter even? '(1 2 3 4 5 6))    ; => (2 4 6)
(iota 5)                          ; => (0 1 2 3 4)
(take '(1 2 3 4 5) 3)            ; => (1 2 3)
(drop '(1 2 3 4 5) 3)            ; => (4 5)
(fold + 0 '(1 2 3 4 5))          ; => 15

;; SRFI-26: 部分应用（cut）
(use-modules (srfi srfi-26))

(map (cut * 2 <>) '(1 2 3 4 5))  ; => (2 4 6 8 10)
(map (cut list 1 <> 3) '(a b c)) ; => ((1 a 3) (1 b 3) (1 c 3))

;; SRFI-31: 递归命名表达式
(use-modules (srfi srfi-31))

(rec (fact
      (lambda (n)
        (if (<= n 1) 1 (* n (fact (- n 1))))))
  (fact 10))  ; => 3628800

;; ============== Guile Scheme ==============

;; 函数定义
(define (greet name)
  (string-append "Hello, " name "!"))

;; 条件表达式
(define (describe n)
  (cond
    ((< n 0) "negative")
    ((= n 0) "zero")
    (else "positive")))

;; 命名 let（循环惯用法）
(let loop ((i 0))
  (when (< i 5)
    (display i) (newline)
    (loop (+ i 1))))

;; 多值返回
(define (divmod a b)
  (values (quotient a b) (remainder a b)))

(call-with-values
  (lambda () (divmod 17 5))
  (lambda (q r)
    (format #t "~a 余 ~a~%" q r)))

;; ============== Common Lisp ==============

;; 函数定义 —— 需要显式声明函数
(defun greet (name)
  (format nil "Hello, ~a!" name))

;; 条件表达式
(defun describe (n)
  (cond
    ((< n 0) "negative")
    ((= n 0) "zero")
    (t "positive")))  ;; T 而非 else

;; 循环 —— 使用 loop 宏
(loop for i from 0 below 5
      do (format t "~a~%" i))

;; 多值返回
(defun divmod (a b)
  (values (floor a b) (mod a b)))

(multiple-value-bind (q r)
    (divmod 17 5)
  (format t "~a 余 ~a~%" q r))

;; 使用 Guile 作为配置语言，替代 YAML/JSON
;; config.scm

(define *server-config*
  '((host . "0.0.0.0")
    (port . 8080)
    (workers . 4)
    (database
      . ((adapter . "postgresql")
         (host . "localhost")
         (port . 5432)
         (name . "myapp")))
    (logging
      . ((level . "info")
         (file . "/var/log/app.log")))))

;; 配置读取函数
(define (config-get config key)
  (let ((entry (assq config key)))
    (if entry (cdr entry) #f)))

;; 使用示例
(config-get *server-config* 'port)  ; => 8080

;; 数据处理管道
(use-modules (srfi srfi-1)
             (ice-9 regex)
             (json))

(define (process-log-lines lines)
  "处理日志行，提取错误信息并统计"
  (let* ((error-lines (filter
                        (lambda (line)
                          (string-contains line "ERROR"))
                        lines))
         (parsed (map
                   (lambda (line)
                     (let ((m (string-match
                                "\\[(.+?)\\] ERROR (.+)" line)))
                       (if m
                           `((time . ,(match:substring m 1))
                             (message . ,(match:substring m 2)))
                           #f)))
                   error-lines))
         (valid (filter identity parsed)))
    `((total-errors . ,(length valid))
      (errors . ,valid))))

# 检查 Guile 版本
guile --version
# GNU Guile 3.0.9
# Copyright (C) 1995-2024 Free Software Foundation, Inc.