X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpackage.lisp;h=b16e9bbdbf70f759755ba672d455cd92c85f4826;hb=68cd2db6542fa3442d46b0331ecf8be8f86c09c2;hp=0a2e583f616d2753ba4c840453bc23db0f2576ba;hpb=b41c97afacb4c90eb1b4538c76b415bfa9d29e08;p=jscl.git diff --git a/src/package.lisp b/src/package.lisp index 0a2e583..b16e9bb 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,17 +1,17 @@ ;;; package.lisp --- -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see . +;; along with JSCL. If not, see . (defvar *package-list* nil) @@ -41,7 +41,7 @@ (defun find-package-or-fail (package-designator) (or (find-package package-designator) - (error "Package unknown."))) + (error "The name `~S' does not designate any package." package-designator))) (defun package-name (package-designator) (let ((package (find-package-or-fail package-designator))) @@ -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,28 +123,14 @@ (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))))))) (defun symbol-package (symbol) (unless (symbolp symbol) - (error "it is not a symbol")) + (error "`~S' is not a symbol." symbol)) (oget symbol "package")) (defun export (symbols &optional (package *package*))