diff options
author | Andy Wingo <wingo@pobox.com> | 2012-03-12 17:00:02 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-03-12 17:00:02 +0100 |
commit | da23abd9706390d655b120eb1384236113238b19 (patch) | |
tree | 819fa6ac6efd201cb8074c0064542ae32dad5fce /module | |
parent | 9effafa444a021d1564800aa81a35098651c5fec (diff) | |
parent | 52d2472441891cbb85ec23d16e685d91c5ed8bfd (diff) | |
download | guile-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.el | 128 |
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)) |