Merge branch 'master' of git.sv.gnu.org:/srv/git/guile

module/language/elisp/boot.el

@@ -131,6 +131,14 @@
             #'(lambda () ,bodyform)
             #'(lambda () ,@unwindforms)))
 
+(defmacro when (cond &rest body)
+  `(if ,cond
+       (progn ,@body)))
+
+(defmacro unless (cond &rest body)
+  `(when (not ,cond)
+     ,@body))
+
 (defun symbolp (object)
   (%funcall (@ (guile) symbol?) object))
 
@@ -214,12 +222,14 @@
 
 ;;; `symbolp' and `symbol-function' are defined above.
 
+(fset 'symbol-name (@ (guile) symbol->string))
 (fset 'symbol-value (@ (language elisp runtime) symbol-value))
 (fset 'set (@ (language elisp runtime) set-symbol-value!))
 (fset 'makunbound (@ (language elisp runtime) makunbound!))
 (fset 'fmakunbound (@ (language elisp runtime) fmakunbound!))
 (fset 'boundp (@ (language elisp runtime) symbol-bound?))
 (fset 'fboundp (@ (language elisp runtime) symbol-fbound?))
+(fset 'intern (@ (guile) string->symbol))
 
 (defun defvaralias (new-alias base-variable &optional docstring)
   (let ((fluid (funcall (@ (language elisp runtime) symbol-fluid)
@@ -237,16 +247,14 @@
            (null (funcall (@ (guile) integer?) object)))))
 
 (defun integerp (object)
-  (and (funcall (@ (guile) exact?) object)
-       (funcall (@ (guile) integer?) object)))
+  (and (funcall (@ (guile) integer?) object)
+       (funcall (@ (guile) exact?) object)))
 
 (defun numberp (object)
   (funcall (@ (guile) real?) object))
 
 (defun wholenump (object)
-  (and (funcall (@ (guile) exact?) object)
-       (funcall (@ (guile) integer?) object)
-       (>= object 0)))
+  (and (integerp object) (>= object 0)))
 
 (defun zerop (object)
   (= object 0))
@@ -310,6 +318,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)
@@ -363,12 +372,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))
@@ -376,6 +452,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)
@@ -493,3 +583,31 @@
 
 (defun format* (stream string &rest args)
   (apply (@ (guile) format) stream string args))
+
+(defun send-string-to-terminal (string)
+  (princ string))
+
+(defun read-from-minibuffer (prompt &rest ignore)
+  (princ prompt)
+  (let ((value (funcall (@ (ice-9 rdelim) read-line))))
+    (if (funcall (@ (guile) eof-object?) value)
+        ""
+      value)))
+
+(defun prin1-to-string (object)
+  (format* nil "~S" object))
+
+;; Random number generation
+
+(defvar %random-state (funcall (@ (guile) copy-random-state)
+                               (@ (guile) *random-state*)))
+
+(defun random (&optional limit)
+  (if (eq limit t)
+      (setq %random-state
+            (funcall (@ (guile) random-state-from-platform))))
+  (funcall (@ (guile) random)
+           (if (wholenump limit)
+               limit
+             (@ (guile) most-positive-fixnum))
+           %random-state))