elisp sequence functions

* module/language/elisp/boot.el (nreverse, assoc, assq, rplaca, rplacd)
  (caar, cadr, cdar, cddr, dolist, stringp, string-equal, string=)
  (substring, upcase, downcase, string-match, make-vector, mapc, aref)
  (aset, concat): New functions.

1 files changed, 82 insertions, 0 deletions

diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el
index 1ea86397f..29c2e96d5 100644
--- a/module/language/elisp/boot.el
+++ b/module/language/elisp/boot.el
@@ -308,6 +308,7 @@
 (fset 'make-list (@ (guile) make-list))
 (fset 'append (@ (guile) append))
 (fset 'reverse (@ (guile) reverse))
+(fset 'nreverse (@ (guile) reverse!))
 
 (defun car-safe (object)
   (if (consp object)
@@ -361,12 +362,79 @@
 (defun memq (elt list)
   (%member elt list #'eq))
 
+(defun assoc (key list)
+  (funcall (@ (srfi srfi-1) assoc) key list #'equal))
+
+(defun assq (key list)
+  (funcall (@ (srfi srfi-1) assoc) key list #'eq))
+
+(defun rplaca (cell newcar)
+  (funcall (@ (guile) set-car!) cell newcar)
+  newcar)
+
+(defun rplacd (cell newcdr)
+  (funcall (@ (guile) set-cdr!) cell newcdr)
+  newcdr)
+
+(defun caar (x)
+  (car (car x)))
+
+(defun cadr (x)
+  (car (cdr x)))
+
+(defun cdar (x)
+  (cdr (car x)))
+
+(defun cddr (x)
+  (cdr (cdr x)))
+
+(defmacro dolist (spec &rest body)
+  (apply #'(lambda (var list &optional result)
+             `(mapc #'(lambda (,var)
+                        ,@body
+                        ,result)
+                    ,list))
+         spec))
+
 ;;; Strings
 
 (defun string (&rest characters)
   (funcall (@ (guile) list->string)
            (mapcar (@ (guile) integer->char) characters)))
 
+(defun stringp (object)
+  (funcall (@ (guile) string?) object))
+
+(defun string-equal (s1 s2)
+  (let ((s1 (if (symbolp s1) (symbol-name s1) s1))
+        (s2 (if (symbolp s2) (symbol-name s2) s2)))
+   (funcall (@ (guile) string=?) s1 s2)))
+
+(fset 'string= 'string-equal)
+
+(defun substring (string from &optional to)
+  (apply (@ (guile) substring) string from (if to (list to) nil)))
+
+(defun upcase (obj)
+  (funcall (@ (guile) string-upcase) obj))
+
+(defun downcase (obj)
+  (funcall (@ (guile) string-downcase) obj))
+
+(defun string-match (regexp string &optional start)
+  (let ((m (funcall (@ (ice-9 regex) string-match)
+                    regexp
+                    string
+                    (or start 0))))
+    (if m
+        (funcall (@ (ice-9 regex) match:start) m 0)
+      nil)))
+
+;; Vectors
+
+(defun make-vector (length init)
+  (funcall (@ (guile) make-vector) length init))
+
 ;;; Sequences
 
 (fset 'length (@ (guile) length))
@@ -374,6 +442,20 @@
 (defun mapcar (function sequence)
   (funcall (@ (guile) map) function sequence))
 
+(defun mapc (function sequence)
+  (funcall (@ (guile) for-each) function sequence)
+  sequence)
+
+(defun aref (array idx)
+  (funcall (@ (guile) generalized-vector-ref) array idx))
+
+(defun aset (array idx newelt)
+  (funcall (@ (guile) generalized-vector-set!) array idx newelt)
+  newelt)
+
+(defun concat (&rest sequences)
+  (apply (@ (guile) string-append) sequences))
+
 ;;; Property lists
 
 (defun %plist-member (plist property test)