Multiple chaining keys in oset* and oset

diff --git a/src/array.lisp b/src/array.lisp
index 44ad0cf..150c70d 100644 (file)
--- a/src/array.lisp
+++ b/src/array.lisp
@@ -26,7 +26,7 @@
     ;; Upgrade type
     (if (eq element-type 'character)
         (progn
-          (oset array "stringp" 1)
+          (oset 1 array "stringp")
           (setf element-type 'character
                 initial-element (or initial-element #\space)))
         (setf element-type t))
@@ -34,8 +34,8 @@
     (dotimes (i size)
       (storage-vector-set array i initial-element))
     ;; Record and return the object
-    (oset array "type" element-type)
-    (oset array "dimensions" dimensions)
+    (oset element-type array "type")
+    (oset dimensions array "dimensions")
     array))
 
 

diff --git a/src/boot.lisp b/src/boot.lisp
index 59b97a0..54b499a 100644 (file)
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -44,7 +44,7 @@
      (declaim (special ,name))
      (declaim (constant ,name))
      (setq ,name ,value)
-     ,@(when (stringp docstring) `((oset ',name "vardoc" ,docstring)))
+     ,@(when (stringp docstring) `((oset ,docstring ',name "vardoc")))
      ',name))
 
 (defconstant t 't)
@@ -64,13 +64,13 @@
   `(progn
      (declaim (special ,name))
      ,@(when value-p `((unless (boundp ',name) (setq ,name ,value))))
-     ,@(when (stringp docstring) `((oset ',name "vardoc" ,docstring)))
+     ,@(when (stringp docstring) `((oset ,docstring ',name "vardoc")))
      ',name))
 
 (defmacro defparameter (name value &optional docstring)
   `(progn
      (setq ,name ,value)
-     ,@(when (stringp docstring) `((oset ',name "vardoc" ,docstring)))
+     ,@(when (stringp docstring) `((oset ,docstring ',name "vardoc")))
      ',name))
 
 (defmacro defun (name args &rest body)

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 1d1ea55..02a3d43 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -1309,25 +1309,30 @@
 
 (define-builtin new () "{}")
 
-(define-builtin oget* (object key)
-  (js!selfcall
-    "var tmp = " "(" object ")[xstring(" key ")];" *newline*
-    "return tmp == undefined? " (ls-compile nil) ": tmp ;" *newline*))
-
-(define-builtin oset* (object key value)
-  (code "((" object ")[xstring(" key ")] = " value ")"))
-
-(define-raw-builtin oget (object key &rest keys)
+(define-raw-builtin oget* (object key &rest keys)
   (js!selfcall
     "var tmp = (" (ls-compile object) ")[xstring(" (ls-compile key) ")];" *newline*
     (mapconcat (lambda (key)
                  (code "if (tmp === undefined) return " (ls-compile nil) ";" *newline*)
                  (code "tmp = tmp[xstring(" (ls-compile key) ")];" *newline*))
                keys)
-    "return tmp === undefined? " (ls-compile nil) " : js_to_lisp(tmp);" *newline*))
+    "return tmp === undefined? " (ls-compile nil) " : tmp;" *newline*))
+
+(define-raw-builtin oset* (value object key &rest keys)
+  (let ((keys (cons key keys)))
+    (js!selfcall
+      "var obj = " (ls-compile object) ";" *newline*
+      (mapconcat (lambda (key)
+                   "obj = obj[xstring(" (ls-compile key) ")];"
+                   "if (obj === undefined) throw 'Impossible to set Javascript property.';" *newline*)
+                 (butlast keys))
+      "obj[xstring(" (ls-compile (car (last keys))) ")] = " (ls-compile value) ";" *newline*)))
+
+(define-raw-builtin oget (object key &rest keys)
+  (code "js_to_lisp(" (ls-compile `(oget* ,object ,key ,@keys)) ")"))
 
-(define-builtin oset (object key value)
-  (code "((" object ")[xstring(" key ")] = lisp_to_js(" value "))"))
+(define-raw-builtin oset (value object key &rest keys)
+  (ls-compile `(oset* (lisp-to-js ,value) ,object ,key ,@keys)))
 
 (define-builtin objectp (x)
   (js!bool (code "(typeof (" x ") === 'object')")))
@@ -1426,8 +1431,7 @@
             #+jscl (eq (symbol-package function) (find-package "COMMON-LISP"))
             #-jscl t)
        (code (ls-compile `',function) ".fvalue" arglist))
-      #+jscl
-      ((symbolp function)
+      #+jscl((symbolp function)
        (code (ls-compile `#',function) arglist))
       ((and (consp function) (eq (car function) 'lambda))
        (code (ls-compile `#',function) arglist))

diff --git a/src/package.lisp b/src/package.lisp
index b74fbaa..1cb4de1 100644 (file)
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -21,10 +21,10 @@
 (defun make-package (name &key use)
   (let ((package (new))
         (use (mapcar #'find-package-or-fail use)))
-    (oset package "packageName" name)
-    (oset package "symbols" (new))
-    (oset package "exports" (new))
-    (oset package "use" use)
+    (oset name package "packageName")
+    (oset (new) package "symbols")
+    (oset (new) package "exports")
+    (oset use package "use")
     (push package *package-list*)
     package))
 
@@ -86,12 +86,12 @@
               *common-lisp-package*))
          (symbols (%package-symbols package))
          (exports (%package-external-symbols package)))
-    (oset symbol "package" package)
-    (oset symbols (symbol-name symbol) symbol)
+    (oset package symbol "package")
+    (oset symbol symbols (symbol-name symbol))
     ;; Turn keywords self-evaluated and export them.
     (when (eq package *keyword-package*)
-      (oset symbol "value" symbol)
-      (oset exports (symbol-name symbol) symbol))))
+      (oset symbol symbol "value")
+      (oset symbol exports (symbol-name symbol)))))
 
 (defun find-symbol (name &optional (package *package*))
   (let* ((package (find-package-or-fail package))
@@ -122,13 +122,13 @@
           (let ((symbols (%package-symbols package)))
             (oget symbols name)
             (let ((symbol (make-symbol name)))
-              (oset symbol "package" package)
+              (oset package symbol "package")
               (when (eq package *keyword-package*)
-                (oset symbol "value" symbol)
+                (oset symbol symbol "value")
                 (export (list symbol) package))
               (when *intern-hook*
                 (funcall *intern-hook* symbol))
-              (oset symbols name symbol)
+              (oset symbol symbols name)
               (values symbol nil)))))))
 
 (defun symbol-package (symbol)
@@ -139,7 +139,7 @@
 (defun export (symbols &optional (package *package*))
   (let ((exports (%package-external-symbols package)))
     (dolist (symb symbols t)
-      (oset exports (symbol-name symb) symb))))
+      (oset symb exports (symbol-name symb)))))
 
 (defun %map-external-symbols (function package)
   (map-for-in function (%package-external-symbols package)))