git » jacl.git » commit 0dd76f4

diff --git a/boot.lisp b/boot.lisp
index c6b9152..f5f836e 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -566,6 +566,27 @@
         ,(caddr binding))
      ,@body))
 
+(%export 'some)
+(defun some (predicate &rest sequences)
+  (let* ((sequences (%js "[...~{}]"
+                         (%mapcar (lambda (sequence)
+                                    (%js "[...~{}]" sequence))
+                                  sequences)))
+         (shortest (%js "Math.min(...~{}.map(x => x.length))" sequences)))
+    (do* ((i 0 (1+ i)))
+         ((eql i (1+ shortest)))
+      (let ((args (%js "~{}.map(x => x[~{}])" sequences i)))
+        (when (%js "~{}(...~{}) === null ? null : true" predicate args)
+          (return-from some t))))))
+
+(%export 'mapcar)
+(defun mapcar (function &rest lists)
+  (do* ((collect (%collector)))
+       ((%js "[...~{}].some(x => x === null) ? true : null" lists)
+        (funcall collect))
+    (funcall collect (apply function (%mapcar #'car lists)))
+    (setq lists (%mapcar #'cdr lists))))
+
 ;; designators
 
 (defun %designated-string (x)
@@ -589,14 +610,37 @@
                              (|toString|))))))
     (\. package (|usePackage| pkg))))
 
-(setq *package* (\. (%js "Package") (|get| (\. '#:jacl |name|))))
-(\. cl:*package* (|usePackage| (\. (%js "Package") (|get| (\. '#:common-lisp |name|)))))
+(%export 'in-package)
+(defmacro in-package (name)
+  (let ((name-string (%designated-string name)))
+    `(setq *package* (\. (%js "Package") (|get| (\. ,name-string (|toString|)))))))
+
+(%export 'make-package)
+(defun make-package (package-name &key nicknames use)
+  ;; TODO error if package exists
+  (let* ((package-name-js (\. (%designated-string package-name) (|toString|)))
+         (new-package (%js "Package.makePackage(~{}, ...Cons.toArray(~{}))"
+                           package-name-js
+                           (mapcar (lambda (x)
+                                     (\. (%designated-string x) (|toString|)))
+                                   nicknames))))
+    (dolist (u use new-package)
+      (use-package u new-package))))
+
+(%export 'export)
+(defun export (symbols &optional (package *package*))
+  ;; TODO error when symbols not accessible
+  (dolist (sym (%designated-symbols symbols) t)
+    (%export sym package)))
+
+(in-package #:jacl)
+(use-package '#:common-lisp)
 
 (cl::%export 'fetch-load)
 (defun fetch-load (src &aux (src (\. src (|toString|))))
   (%js "fetchLoad(~{})" src))
 
-(cl:setq cl:*package* (\. (%js "Package") (|get| (\. '#:common-lisp |name|))))
+(in-package #:common-lisp)
 
 (%export 'macroexpand-1)
 (defun macroexpand-1 (form &optional env)
@@ -616,9 +660,8 @@
 
 ;; Use COMMON-LISP from COMMON-LISP-USER and switch to
 ;; COMMON-LISP-USER
-(%let ((cl-user-pkg (\. (%js "Package") (|get| (\. '#:common-lisp-user |name|)))))
-  (\. cl-user-pkg (|usePackage| cl:*package*))
-  (%setq cl:*package* cl-user-pkg))
+(in-package #:common-lisp-user)
+(cl:use-package '#:common-lisp)
 
 ;; Local Variables:
 ;; eval: (put '%let 'lisp-indent-function 1)