Add and export DO-(ALL/EXTERNAL)-SYMBOLS.
authorOlof-Joachim Frahm <olof@macrolet.net>
Fri, 17 May 2013 22:47:26 +0000 (00:47 +0200)
committerOlof-Joachim Frahm <olof@macrolet.net>
Fri, 17 May 2013 23:05:30 +0000 (01:05 +0200)
src/compiler.lisp
src/package.lisp
src/toplevel.lisp

index 5ef99f3..58f4a87 100644 (file)
 (define-builtin in (key object)
   (js!bool (code "(xstring(" key ") in (" object "))")))
 
 (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')")))
 
 (define-builtin functionp (x)
   (js!bool (code "(typeof " x " == 'function')")))
 
index b10c1cc..834a95a 100644 (file)
   (let ((exports (%package-external-symbols package)))
     (dolist (symb symbols t)
       (oset exports (symbol-name symb) symb))))
   (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))))))
index c498c42..3336333 100644 (file)
@@ -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
           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
           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