mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 19:50:24 +02:00
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.
This commit is contained in:
parent
fc45b7e8e8
commit
12c00a0453
1 changed files with 82 additions and 0 deletions
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue