add list-set! and nth-pair functions #269

CHANGELOG.md

@@ -7,6 +7,7 @@
 * add `string-for-each`, `string-downcase`, and `string-upcase` from R7RS
 * add `typecheck-number` function
 * add `char-foldcase` and `string-foldcase` functions
+* add `list-set!` and `nth-pair` functions
 * add `SRFI-210`
 * add `syntax-parameterize` from SRFI-139 to the core [#210](https://github.com/jcubic/lips/issues/210)
 ### Bugfix

lib/R5RS.scm

@@ -577,18 +577,10 @@
   "(list-ref list n)
 
    Returns n-th element of a list."
-  (typecheck "list-ref" l '("pair" "nil"))
-  (if (< k 0)
-      (throw (new Error "list-ref: index out of range"))
-      (let ((l l) (k k))
-        (while (> k 0)
-          (if (or (null? (cdr l)) (null? l))
-              (throw (new Error "list-ref: not enough elements in the list")))
-          (set! l (cdr l))
-          (set! k (- k 1)))
-        (if (null? l)
-            l
-            (car l)))))
+  (let ((l (%nth-pair "list-ref" l k)))
+    (if (null? l)
+        l
+        (car l))))
 
 ;; -----------------------------------------------------------------------------
 (define (not x)

lib/R7RS.scm

@@ -221,6 +221,7 @@
 
    The macro work similar to let* but variable is list of values and value
    need to evaluate to result of calling values.")
+
 ;; -----------------------------------------------------------------------------
 ;; R7RS division operators (Gauche Scheme) BSD license
 ;; Copyright (c) 2000-2020  Shiro Kawai  <[email protected]>
@@ -1452,6 +1453,13 @@
       obj
       (obj.clone false)))
 
+;; -----------------------------------------------------------------------------
+(define (list-set! l k obj)
+  "(list-set! list n)
+
+   Returns n-th element of a list."
+  (set-car! (%nth-pair "list-set!" l k) obj))
+
 ;; -----------------------------------------------------------------------------
 (define-macro (define-record-type name constructor pred . fields)
   "(define-record-type name constructor pred . fields)

lib/bootstrap.scm

@@ -1558,6 +1558,30 @@
 (define string-join join)
 (define string-split split)
 
+;; -----------------------------------------------------------------------------
+(define (%nth-pair msg l k)
+  "(%nth-pair msg list n)
+
+   Returns nth pair of a list with given message on error."
+  (typecheck msg l '("pair" "nil"))
+  (typecheck-number msg k '("integer" "bigint"))
+  (if (< k 0)
+      (throw (new Error (string-append msg ": index out of range")))
+      (let ((l l) (k k))
+        (while (> k 0)
+          (if (or (null? (cdr l)) (null? l))
+              (throw (new Error (string-append msg ": not enough elements in the list"))))
+          (set! l (cdr l))
+          (set! k (- k 1)))
+        l)))
+
+;; -----------------------------------------------------------------------------
+(define (nth-pair l k)
+  "(nth-pair list n)
+
+   Returns nth pair of a list."
+  (%nth-pair "nth-pair" l k))
+
 ;; -----------------------------------------------------------------------------
 (define (symbol-append . rest)
    "(symbol-append s1 s2 ...)