X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=ecmalisp.lisp;h=20c68124f930d75f4e6268d27329b8f0a5fce5f7;hb=bfc35a4a1c2c0ba780ef686a166529534beb1be4;hp=8ce69d5004040ebc46a2e5541cbb448f73095c9e;hpb=c1ffae5c8872df7e8c7f91dfe3ab26ef32f0eecc;p=jscl.git

diff --git a/ecmalisp.lisp b/ecmalisp.lisp
index 8ce69d5..20c6812 100644
--- a/ecmalisp.lisp
+++ b/ecmalisp.lisp
@@ -587,26 +587,37 @@
   ;; This function is used internally to initialize the CL package
   ;; with the symbols built during bootstrap.
   (defun %intern-symbol (symbol)
-    (let ((symbols (%package-symbols *common-lisp-package*)))
-      (oset symbol "package" *common-lisp-package*)
+    (let* ((package
+            (if (in "package" symbol)
+                (find-package-or-fail (oget symbol "package"))
+                *common-lisp-package*))
+           (symbols (%package-symbols package)))
+      (oset symbol "package" package)
+      (when (eq package *keyword-package*)
+        (oset symbol "value" symbol))
       (oset symbols (symbol-name symbol) symbol)))
 
   (defun find-symbol (name &optional (package *package*))
     (let* ((package (find-package-or-fail package))
+           (externals (%package-external-symbols package))
            (symbols (%package-symbols package)))
-      (if (in name symbols)
-          (values (oget symbols name) t)
-          (dolist (used (package-use-list package) (values nil nil))
-            (let ((exports (%package-external-symbols used)))
-              (when (in name exports)
-                (return (values (oget exports name) t))))))))
+      (cond
+        ((in name externals)
+         (values (oget externals name) :external))
+        ((in name symbols)
+         (values (oget symbols name) :internal))
+        (t
+         (dolist (used (package-use-list package) (values nil nil))
+           (let ((exports (%package-external-symbols used)))
+             (when (in name exports)
+               (return (values (oget exports name) :inherit)))))))))
 
   (defun intern (name &optional (package *package*))
     (let ((package (find-package-or-fail package)))
       (multiple-value-bind (symbol foundp)
           (find-symbol name package)
         (if foundp
-            symbol
+            (values symbol foundp)
             (let ((symbols (%package-symbols package)))
               (oget symbols name)
               (let ((symbol (make-symbol name)))
@@ -614,7 +625,8 @@
                 (when (eq package *keyword-package*)
                   (oset symbol "value" symbol)
                   (export (list symbol) package))
-                (oset symbols name symbol)))))))
+                (oset symbols name symbol)
+                (values symbol nil)))))))
 
   (defun symbol-package (symbol)
     (unless (symbolp symbol)
@@ -1344,12 +1356,17 @@
     ((symbolp sexp)
      (or (cdr (assoc sexp *literal-symbols*))
 	 (let ((v (genlit))
-	       (s #+common-lisp (concat "{name: \"" (escape-string (symbol-name sexp)) "\"}")
-		  #+ecmalisp
-                  (let ((package (symbol-package sexp)))
-                    (if (null package)
-                        (concat "{name: \"" (escape-string (symbol-name sexp)) "\"}")
-                        (ls-compile `(intern ,(symbol-name sexp) ,(package-name package)))))))
+	       (s #+common-lisp
+                 (let ((package (symbol-package sexp)))
+                   (if (eq package (find-package "KEYWORD"))
+                       (concat "{name: \"" (escape-string (symbol-name sexp))
+                               "\", 'package': '" (package-name package) "'}")
+                       (concat "{name: \"" (escape-string (symbol-name sexp)) "\"}")))
+                 #+ecmalisp
+                 (let ((package (symbol-package sexp)))
+                   (if (null package)
+                       (concat "{name: \"" (escape-string (symbol-name sexp)) "\"}")
+                       (ls-compile `(intern ,(symbol-name sexp) ,(package-name package)))))))
 	   (push (cons sexp v) *literal-symbols*)
 	   (toplevel-compilation (concat "var " v " = " s))
 	   v)))