From 72044f33f065e890d6fdbbded154b47f8b026fcd Mon Sep 17 00:00:00 2001
From: Vladimir Sedach <vsedach@gmail.com>
Date: Fri, 5 Dec 2008 14:23:04 -0700
Subject: [PATCH] Got rid of parenscript-symbol object; special forms and
 macros are now regular Common Lisp symbols so that the package system works
 as expected.

---
 src/compiler.lisp   | 70 +++++++++++++++++----------------------------
 src/package.lisp    |  1 +
 t/test-package.lisp |  2 +-
 3 files changed, 29 insertions(+), 44 deletions(-)

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 3f0cc79..e93d8e6 100644
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -1,39 +1,21 @@
 (in-package :parenscript)
 
-(defvar *ps-symbols* (make-hash-table :test 'equal))
-(defvar *ps-literals* (make-hash-table :test 'eq))
-(defvar *ps-special-forms* (make-hash-table :test 'eq))
+;;; reserved symbols/literals
 
-(defclass parenscript-symbol ()
-  ((name :initarg :name :accessor name-of)))
+(defvar *ps-reserved-symbol-names* ()) ;; symbol names reserved for PS/JS literals
 
-(defmethod print-object ((obj parenscript-symbol) stream)
-  (format stream "~a" (name-of obj)))
+(defun add-ps-literal (name)
+  (push (symbol-name name) *ps-reserved-symbol-names*))
 
-(defun find-ps-symbol (symbol)
-  (multiple-value-bind (sym hit?) (gethash (string symbol) *ps-symbols*)
-    (when hit? sym)))
+(defun ps-literal-p (symbol)
+  (find (symbol-name symbol) *ps-reserved-symbol-names* :test #'equalp))
 
-(defun ps-intern (thing)
-  (if (typep thing 'parenscript-symbol) thing
-      (let ((str (string thing)))
-        (multiple-value-bind (sym hit?) (gethash str *ps-symbols*)
-          (if hit? sym
-              (setf (gethash str *ps-symbols*)
-                    (make-instance 'parenscript-symbol :name str)))))))
+;;; special forms
 
-(defun get-ps-special-form (name)
-  "Returns the special form function corresponding to the given name."
-  (gethash (find-ps-symbol name) *ps-special-forms*))
-
-(defun add-ps-literal (name &aux (sym (ps-intern name)))
-  (setf (gethash sym *ps-literals*) sym))
+(defvar *ps-special-forms* (make-hash-table :test 'eq))
 
-(defun undefine-ps-special-form (name &aux (sym (ps-intern name)))
-  "Undefines the special form with the given name (name is a symbol)."
-  (remhash sym *ps-special-forms*)
-  (remhash sym *ps-literals*)
-  t)
+(defun get-ps-special-form (name)
+  (gethash name *ps-special-forms*))
 
 (defmacro define-ps-special-form (name lambda-list &rest body)
   "Define a special form NAME. The first argument given to the special
@@ -41,12 +23,22 @@ form is a keyword indicating whether the form is expected to produce
 an :expression or a :statement. The resulting Parenscript language
 types are appended to the ongoing javascript compilation."
   (let ((arglist (gensym "ps-arglist-")))
-    `(setf (gethash (ps-intern ',name) *ps-special-forms*)
+    `(setf (gethash ',name *ps-special-forms*)
            (lambda (&rest ,arglist)
              (destructuring-bind ,lambda-list
                  ,arglist
                ,@body)))))
 
+(defun undefine-ps-special-form (name)
+  (remhash name *ps-special-forms*))
+
+(defun ps-special-form-p (form)
+  (and (consp form)
+       (symbolp (car form))
+       (gethash (car form) *ps-special-forms*)))
+
+;;; scoping
+
 (defvar *enclosing-lexical-block-declarations* ()
   "This special variable is expected to be bound to a fresh list by
 special forms that introduce a new JavaScript lexical block (currently
@@ -59,14 +51,7 @@ lexical block.")
 
 (defvar *ps-special-variables* ())
 
-;;; ParenScript form predicates
-(defun ps-special-form-p (form)
-  (and (consp form)
-       (symbolp (car form))
-       (gethash (find-ps-symbol (car form)) *ps-special-forms*)))
-
-(defun ps-literal-p (symbol)
-  (gethash (find-ps-symbol symbol) *ps-literals*))
+;;; form predicates
 
 (defun op-form-p (form)
   (and (listp form)
@@ -86,11 +71,10 @@ lexical block.")
 ;;; macro expansion
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun make-macro-env-dictionary ()
-    "Creates a standard macro dictionary."
-    (make-hash-table :test #'equal))
+    (make-hash-table :test 'eq))
   (defvar *ps-macro-toplevel* (make-macro-env-dictionary)
-    "Toplevel macro environment dictionary. Key is the symbol of the
-macro, value is (symbol-macro-p . expansion-function).")
+    "Toplevel macro environment dictionary. Key is the symbol name of
+    the macro, value is (symbol-macro-p . expansion-function).")
   (defvar *ps-macro-env* (list *ps-macro-toplevel*)
     "Current macro environment.")
 
@@ -103,10 +87,10 @@ stored as the second value.")
   (defun get-macro-spec (name env-dict)
     "Retrieves the macro spec of the given name with the given environment dictionary.
 SPEC is of the form (symbol-macro-p . expansion-function)."
-    (gethash (find-ps-symbol name) env-dict))
+    (gethash name env-dict))
   (defsetf get-macro-spec (name env-dict)
       (spec)
-    `(setf (gethash (ps-intern ,name) ,env-dict) ,spec)))
+    `(setf (gethash ,name ,env-dict) ,spec)))
 
 (defun lookup-macro-spec (name &optional (environment *ps-macro-env*))
   "Looks up the macro spec associated with NAME in the given environment.  A
diff --git a/src/package.lisp b/src/package.lisp
index cea9063..834abea 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -10,6 +10,7 @@
       #:this
       #:false
       #:undefined
+      #:{}
 
       ;; keywords
       #:break
diff --git a/t/test-package.lisp b/t/test-package.lisp
index 9a69b71..f4c2c37 100644
--- a/t/test-package.lisp
+++ b/t/test-package.lisp
@@ -2,7 +2,7 @@
 
 (defpackage :parenscript-test
   (:nicknames :ps-test :ps-tests :parenscript-tests)
-  (:use :common-lisp :js :5am)
+  (:use :common-lisp :parenscript :5am)
   (:shadowing-import-from :js :!)
   (:export #:run-tests
            #:make-reference-tests-dot-lisp))
-- 
2.20.1