Move FFI code to src/ffi.lisp

diff --git a/jscl.lisp b/jscl.lisp
index e49e696..9a89a5d 100644 (file)
--- a/jscl.lisp
+++ b/jscl.lisp
@@ -24,6 +24,7 @@
     ("string"    :target)
     ("print"     :target)
     ("package"   :target)
+    ("ffi"       :target)
     ("read"      :both)
     ("compiler"  :both)
     ("toplevel"  :target)))

diff --git a/src/ffi.lisp b/src/ffi.lisp
new file mode 100644 (file)
index 0000000..7d902a7
--- /dev/null
+++ b/src/ffi.lisp
@@ -0,0 +1,37 @@
+;;; ffi.lisp ---
+
+;; JSCL is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; JSCL is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
+
+(defvar *js-package*
+  (make-package "JS"))
+
+(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 ,args)))
+                       (%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)

diff --git a/src/package.lisp b/src/package.lisp
index 5745d07..b16e9bb 100644 (file)
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -62,9 +62,6 @@
 (defvar *common-lisp-package*
   (make-package "CL"))
 
-(defvar *js-package*
-  (make-package "JS"))
-
 (defvar *user-package*
   (make-package "CL-USER" :use (list *common-lisp-package*)))
 
@@ -108,6 +105,11 @@
            (when (in name exports)
              (return (values (oget exports name) :inherit)))))))))
 
+
+;;; It is a function to call when a symbol is interned. The function
+;;; is invoked with the already interned symbol as argument.
+(defvar *intern-hook* nil)
+
 (defun intern (name &optional (package *package*))
   (let ((package (find-package-or-fail package)))
     (multiple-value-bind (symbol foundp)
@@ -121,22 +123,8 @@
               (when (eq package *keyword-package*)
                 (oset symbol "value" symbol)
                 (export (list symbol) package))
-              (when (eq package *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 ,args)))
-                                   (%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)))))
+              (when *intern-hook*
+                (funcall *intern-hook* symbol))
               (oset symbols name symbol)
               (values symbol nil)))))))