X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fffi.lisp;h=db6a23ec21bf0606797ce00194bced400f4f8a19;hb=916539de6153df7b4f6838c5e03ef420a890256c;hp=73d95a0895df12fa9f7939f7f8ca12d8476220f6;hpb=84e86dfe99d64c1cb0bec680c9154dd9b2d34ca6;p=jscl.git diff --git a/src/ffi.lisp b/src/ffi.lisp index 73d95a0..db6a23e 100644 --- a/src/ffi.lisp +++ b/src/ffi.lisp @@ -13,28 +13,35 @@ ;; You should have received a copy of the GNU General Public License ;; along with JSCL. If not, see . -(defvar *js-package* - (make-package "JS")) +(/debug "loading ffi.lisp!") + +(define-setf-expander oget (object key &rest keys) + (let* ((keys (cons key keys)) + (g!object (gensym)) + (g!keys (mapcar (lambda (s) + (declare (ignore s)) + (gensym)) + keys)) + (g!value (gensym))) + (values `(,g!object ,@g!keys) + `(,object ,@keys) + `(,g!value) + `(oset ,g!value ,g!object ,@g!keys) + `(oget ,g!object ,@g!keys)))) + +(define-setf-expander oget* (object key &rest keys) + (let* ((keys (cons key keys)) + (g!object (gensym)) + (g!keys (mapcar (lambda (s) + (declare (ignore s)) + (gensym)) + keys)) + (g!value (gensym))) + (values `(,g!object ,@g!keys) + `(,object ,@keys) + `(,g!value) + `(oset* ,g!value ,g!object ,@g!keys) + `(oget* ,g!object ,@g!keys)))) -(defun lisp-to-js (x) (%lisp-to-js x)) -(defun js-to-list (x) (%js-to-lisp x)) -(defun ffi-intern-hook (symbol) - (when (eq (symbol-package symbol) *js-package*) - (let ((sym-name (symbol-name symbol)) - (args (gensym))) - ;; Generate a trampoline to call the JS function - ;; properly. This trampoline is very inefficient, - ;; but it still works. Ideas to optimize this are - ;; provide a special lambda keyword - ;; cl::&rest-vector to avoid list argument - ;; consing, as well as allow inline declarations. - (fset symbol - (eval `(lambda (&rest ,args) - (let ((,args (list-to-vector (mapcar #'lisp-to-js ,args)))) - (js-to-list (%js-call (%js-vref ,sym-name) ,args)))))) - ;; Define it as a symbol macro to access to the - ;; Javascript variable literally. - (%define-symbol-macro symbol `(%js-vref ,(string symbol)))))) -(setq *intern-hook* #'ffi-intern-hook)