summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-03-12 17:00:02 +0100
committerAndy Wingo <wingo@pobox.com>2012-03-12 17:00:02 +0100
commitda23abd9706390d655b120eb1384236113238b19 (patch)
tree819fa6ac6efd201cb8074c0064542ae32dad5fce /module
parent9effafa444a021d1564800aa81a35098651c5fec (diff)
parent52d2472441891cbb85ec23d16e685d91c5ed8bfd (diff)
downloadguile-da23abd9706390d655b120eb1384236113238b19.tar.gz
Merge branch 'master' of git.sv.gnu.org:/srv/git/guile
Diffstat (limited to 'module')
-rw-r--r--module/language/elisp/boot.el128
1 files changed, 123 insertions, 5 deletions
diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el
index bec32b545..53711e1f6 100644
--- a/module/language/elisp/boot.el
+++ b/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))