From 35f65cfe6e5e2f000a431b78bb913fd6cd4fc777 Mon Sep 17 00:00:00 2001
From: Darcy Shen <da@liii.pro>
Date: Thu, 27 Jun 2024 11:02:14 +0800
Subject: [PATCH 1/2] SRFI 1: List Library

---
 AUTHORS         |   1 +
 srfi/srfi-1.scm | 159 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 160 insertions(+)
 create mode 100644 srfi/srfi-1.scm

diff --git a/AUTHORS b/AUTHORS
index dd707a43..8ee9e8b0 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -7,3 +7,4 @@
 Liii Network Inc.
 
 沈达 <da@liii.pro>
+刘念 <nian@liii.pro>
diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm
new file mode 100644
index 00000000..bd637396
--- /dev/null
+++ b/srfi/srfi-1.scm
@@ -0,0 +1,159 @@
+;;; SRFI-1 list-processing library                      -*- Scheme -*-
+;;; Reference implementation
+;;;
+;;; SPDX-License-Identifier: MIT
+;;;
+;;; Copyright (c) 1998, 1999 by Olin Shivers. You may do as you please with
+;;; this code as long as you do not remove this copyright notice or
+;;; hold me liable for its use. Please send bug reports to shivers@ai.mit.edu.
+;;;     -Olin
+;;;
+;;; Copyright (c) 2024 The S7 SRFI Authors
+;;; Follow the same License as the original one
+
+(provide 'srfi-1)
+(provide 'null-list?)
+(provide 'first)
+(provide 'second)
+(provide 'third)
+(provide 'tenth)
+(provide 'take)
+(provide 'drop)
+(provide 'take-right)
+(provide 'drop-right)
+(provide 'count)
+(provide 'fold)
+(provide 'fold-right)
+(provide 'reduce)
+(provide 'reduce-right)
+(provide 'filter)
+(provide 'partition)
+(provide 'remove)
+(provide 'find)
+(provide 'take-while)
+(provide 'drop-while)
+(provide 'check-report)
+(provide 'check-reset!)
+
+(define (null-list? l)
+  (cond ((pair? l) #f)
+        ((null? l) #t)
+        (else
+         (error 'wrong-type-arg "null-list?: argument out of domain" l))))
+
+(define first car)
+
+(define second cadr)
+
+(define third caddr)
+
+(define (fourth x) (list-ref x 3))
+
+(define (fifth x) (list-ref x 4))
+
+(define (sixth x) (list-ref x 5))
+
+(define (seventh x) (list-ref x 6))
+
+(define (eighth x) (list-ref x 7))
+
+(define (ninth x) (list-ref x 8))
+
+(define (tenth x) 
+  (cadr (cddddr (cddddr x))))
+
+(define (take l k)
+  (let recur ((l l) (k k))
+    (if (zero? k) '()
+        (cons (car l)
+              (recur (cdr l) (- k 1))))))
+
+(define (drop l k)
+  (let iter ((l l) (k k))
+    (if (zero? k) l (iter (cdr l) (- k 1)))))
+
+(define (take-right l k)
+  (let lp ((lag l)  (lead (drop l k)))
+    (if (pair? lead)
+        (lp (cdr lag) (cdr lead))
+        lag)))
+
+(define (drop-right l k)
+  (let recur ((lag l) (lead (drop l k)))
+    (if (pair? lead)
+        (cons (car lag) (recur (cdr lag) (cdr lead)))
+        '())))
+
+(define (count pred list1 . lists)
+  (let lp ((lis list1) (i 0))
+    (if (null-list? lis) i
+        (lp (cdr lis) (if (pred (car lis)) (+ i 1) i)))))
+
+(define (fold f initial l)
+  (if (null? l)
+      initial
+      (fold f
+            (f (car l) initial)
+            (cdr l))))
+
+(define (fold-right f initial l)
+  (if (null? l)
+    initial
+    (f (car l)
+        (fold-right f
+                    initial
+                    (cdr l)))))
+
+(define (reduce f initial l)
+  (if (null-list? l) initial
+      (fold f (car l) (cdr l))))
+
+(define (reduce-right f initial l)
+  (if (null-list? l) initial
+      (let recur ((head (car l)) (l (cdr l)))
+        (if (pair? l)
+            (f head (recur (car l) (cdr l)))
+            head))))
+
+(define (filter pred l)
+  (let recur ((l l))
+    (if (null-list? l) l
+        (let ((head (car l))
+              (tail (cdr l)))
+          (if (pred head)
+              (let ((new-tail (recur tail)))
+                (if (eq? tail new-tail) l
+                    (cons head new-tail)))
+              (recur tail))))))
+
+(define (partition pred l)
+  (let loop ((lst l) (satisfies '()) (dissatisfies '()))
+    (cond ((null? lst)
+           (cons satisfies dissatisfies))
+          ((pred (car lst))
+           (loop (cdr lst) (cons (car lst) satisfies) dissatisfies))
+          (else
+           (loop (cdr lst) satisfies (cons (car lst) dissatisfies))))))
+
+(define (remove pred l)
+  (filter (lambda (x) (not (pred x))) l))
+
+(define (find pred l)
+  (cond ((null? l) #f)
+        ((pred (car l)) (car l)) 
+        (else (find pred (cdr l)))))
+
+(define (take-while pred lst)
+  (if (null? lst) 
+      '()
+      (if (pred (car lst))
+          (cons (car lst) (take-while pred (cdr lst)))
+          '())))
+
+(define (drop-while pred l)
+  (if (null? l)
+      '()
+      (if (pred (car l))
+          (drop-while pred (cdr l))
+          l)))
+
-- 
Gitee


From fef40580ad0c19bc56c0b6d12c2594b18cde12bf Mon Sep 17 00:00:00 2001
From: Darcy Shen <da@liii.pro>
Date: Thu, 27 Jun 2024 11:07:59 +0800
Subject: [PATCH 2/2] wip

---
 srfi/srfi-1.scm | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm
index bd637396..c7f84caf 100644
--- a/srfi/srfi-1.scm
+++ b/srfi/srfi-1.scm
@@ -16,6 +16,12 @@
 (provide 'first)
 (provide 'second)
 (provide 'third)
+(provide 'fourth)
+(provide 'fifth)
+(provide 'sixth)
+(provide 'seventh)
+(provide 'eighth)
+(provide 'ninth)
 (provide 'tenth)
 (provide 'take)
 (provide 'drop)
-- 
Gitee