From e18950d9c4c89df245277f561be640ab91a67c14 Mon Sep 17 00:00:00 2001 From: Olof-Joachim Frahm Date: Sat, 18 May 2013 00:47:26 +0200 Subject: [PATCH] Add and export DO-(ALL/EXTERNAL)-SYMBOLS. --- src/compiler.lisp | 10 ++++++++++ src/package.lisp | 39 +++++++++++++++++++++++++++++++++++++++ src/toplevel.lisp | 5 +++-- 3 files changed, 52 insertions(+), 2 deletions(-) diff --git a/src/compiler.lisp b/src/compiler.lisp index 5ef99f3..58f4a87 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -1527,6 +1527,16 @@ (define-builtin in (key object) (js!bool (code "(xstring(" key ") in (" object "))"))) +(define-builtin map-for-in (function object) + (js!selfcall + "var f = " function ";" *newline* + "var g = (typeof f === 'function' ? f : f.fvalue);" *newline* + "var o = " object ";" *newline* + "for (var key in o){" *newline* + (indent "g(" (if *multiple-value-p* "values" "pv") ", 1, o[key]);" *newline*) + "}" + " return " (ls-compile nil) ";" *newline*)) + (define-builtin functionp (x) (js!bool (code "(typeof " x " == 'function')"))) diff --git a/src/package.lisp b/src/package.lisp index b10c1cc..834a95a 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -140,3 +140,42 @@ (let ((exports (%package-external-symbols package))) (dolist (symb symbols t) (oset exports (symbol-name symb) symb)))) + +(defun %map-external-symbols (function package) + (map-for-in function (%package-external-symbols package))) + +(defun %map-symbols (function package) + (map-for-in function (%package-symbols package)) + (dolist (used (package-use-list package)) + (%map-external-symbols function used))) + +(defun %map-all-symbols (function) + (dolist (package *package-list*) + (map-for-in function (%package-symbols package)))) + +(defmacro do-symbols ((var &optional (package '*package*) result-form) + &body body) + `(block nil + (%map-symbols + (lambda (,var) ,@body) + (find-package ,package)) + ,result-form)) + +(defmacro do-external-symbols ((var &optional (package '*package*) + result-form) + &body body) + `(block nil + (%map-external-symbols + (lambda (,var) ,@body) + (find-package ,package)) + ,result-form)) + +(defmacro do-all-symbols ((var &optional result-form) &body body) + `(block nil (%map-all-symbols (lambda (,var) ,@body)) ,result-form)) + +(defun find-all-symbols (string) + (let (symbols) + (dolist (package *package-list*) + (multiple-value-bind (symbol status) (find-symbol string package) + (when status + (pushnew symbol symbols :test #'eq)))))) diff --git a/src/toplevel.lisp b/src/toplevel.lisp index c498c42..3336333 100644 --- a/src/toplevel.lisp +++ b/src/toplevel.lisp @@ -58,8 +58,9 @@ cond cons consp constantly copy-alist copy-list copy-tree decf declaim declare defconstant define-setf-expander define-symbol-macro defmacro defparameter defun defvar destructuring-bind digit-char digit-char-p - disassemble do do* documentation dolist dotimes ecase eighth eq eql - equal error eval every export expt fdefinition fifth find + disassemble do do* documentation dolist dotimes do-all-symbols + do-external-symbols do-symbols ecase eighth eq eql + equal error eval every export expt fdefinition fifth find find-all-symbols find-package find-symbol first flet format fourth fboundp fset funcall function functionp gensym get-internal-real-time get-setf-expansion get-universal-time go identity if in-package incf integerp intern -- 1.7.10.4