X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpackage.lisp;h=d3861e8b075d45501cb8416061e67f16e9f373f0;hb=064ea3b5dfb0d44a71025990d91d54726cb42415;hp=0a2e583f616d2753ba4c840453bc23db0f2576ba;hpb=b41c97afacb4c90eb1b4538c76b415bfa9d29e08;p=jscl.git
diff --git a/src/package.lisp b/src/package.lisp
index 0a2e583..d3861e8 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*)))
@@ -87,11 +84,14 @@
(if (in "package" symbol)
(find-package-or-fail (oget symbol "package"))
*common-lisp-package*))
- (symbols (%package-symbols package)))
+ (symbols (%package-symbols package))
+ (exports (%package-external-symbols package)))
(oset symbol "package" package)
+ (oset symbols (symbol-name symbol) symbol)
+ ;; Turn keywords self-evaluated and export them.
(when (eq package *keyword-package*)
- (oset symbol "value" symbol))
- (oset symbols (symbol-name symbol) symbol)))
+ (oset symbol "value" symbol)
+ (oset exports (symbol-name symbol) symbol))))
(defun find-symbol (name &optional (package *package*))
(let* ((package (find-package-or-fail package))
@@ -108,6 +108,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 +126,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*))