From f326f929d8e55c67eeba53af23ed3ec959afb526 Mon Sep 17 00:00:00 2001
From: Vladimir Sedach <vsedach@gmail.com>
Date: Tue, 25 Dec 2007 00:02:17 +0000
Subject: [PATCH] Made special forms be compiled into named functions in a new
 package, parenscript-special-forms, and introduced literal special forms.

The literal special forms should improve error messages and debugging.
---
 src/compiler.lisp           | 37 +++++++++++++++++++------------------
 src/namespace.lisp          |  2 +-
 src/package.lisp            |  3 +++
 src/special-forms.lisp      |  3 ++-
 t/package-system-tests.lisp |  2 +-
 t/ps-tests.lisp             |  2 +-
 6 files changed, 27 insertions(+), 22 deletions(-)

diff --git a/src/compiler.lisp b/src/compiler.lisp
index bcc2126..6c9997d 100644
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -1,12 +1,13 @@
 (in-package :parenscript)
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defvar *toplevel-special-forms* (make-hash-table :test #'equal)
-    "A hash-table containing functions that implement Parenscript special forms,
-indexed by name (as symbols)")
-  (defun undefine-ps-special-form (name)
-    "Undefines the special form with the given name (name is a symbol)."
-    (remhash (lisp-symbol-to-ps-identifier name :special-form) *toplevel-special-forms*)))
+(defvar *ps-literals* ())
+
+(defun ps-literal-p (symbol)
+  (member symbol *ps-literals*))
+
+(defun undefine-ps-special-form (name)
+  "Undefines the special form with the given name (name is a symbol)."
+  (unintern (lisp-symbol-to-ps-identifier name :special-form) :parenscript-special-forms))
 
 (defmacro define-ps-special-form (name lambda-list &rest body)
   "Define a special form NAME. The first argument given to the special
@@ -14,15 +15,14 @@ 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 (lisp-symbol-to-ps-identifier ',name :special-form) *toplevel-special-forms*)
-      (lambda (&rest ,arglist)
-        (destructuring-bind ,lambda-list
-            ,arglist
-          ,@body)))))
+    `(defun ,(lisp-symbol-to-ps-identifier name :special-form) (&rest ,arglist)
+      (destructuring-bind ,lambda-list
+          ,arglist
+        ,@body))))
 
 (defun get-ps-special-form (name)
   "Returns the special form function corresponding to the given name."
-  (gethash (lisp-symbol-to-ps-identifier name :special-form) *toplevel-special-forms*))
+  (lisp-symbol-to-ps-identifier name :special-form))
 
 (defvar *enclosing-lexical-block-declarations* ()
   "This special variable is expected to be bound to a fresh list by
@@ -38,7 +38,7 @@ lexical block.")
 (defun ps-special-form-p (form)
   (and (consp form)
        (symbolp (car form))
-       (get-ps-special-form (car form))))
+       (find-symbol (symbol-name (car form)) :parenscript-special-forms)))
 
 (defun op-form-p (form)
   (and (listp form)
@@ -225,10 +225,11 @@ the form cannot be compiled to a symbol."
 
 (defmethod compile-parenscript-form ((symbol symbol) &key expecting)
   (declare (ignore expecting))
-  ;; is this the correct behavior?
-  (let ((special-symbol (get-ps-special-form symbol)))
-    (cond (special-symbol (funcall special-symbol :symbol))
-          (t (list 'js-variable symbol)))))
+  (cond ((ps-special-form-p (list symbol))
+         (if (ps-literal-p symbol)
+             (funcall (get-ps-special-form symbol) :symbol)
+             (error "Attempting to use Parenscript special form ~a as variable" symbol)))
+        (t (list 'js-variable symbol))))
 
 (defun compile-function-argument-forms (arg-forms)
   "Compiles a bunch of Parenscript forms from a funcall form to an effective set of
diff --git a/src/namespace.lisp b/src/namespace.lisp
index 3c3fc18..7c5054f 100644
--- a/src/namespace.lisp
+++ b/src/namespace.lisp
@@ -5,7 +5,7 @@
 
 (defun lisp-symbol-to-ps-identifier (symbol context)
   (case context
-    (:special-form (symbol-name symbol))
+    (:special-form (intern (symbol-name symbol) :parenscript-special-forms))
     (:macro symbol)
     (otherwise (symbol-name symbol))))
 
diff --git a/src/package.lisp b/src/package.lisp
index 6ce8db7..5e6b4dd 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -225,3 +225,6 @@
    #:js
    #:js*
    ))
+
+(defpackage :parenscript-special-forms
+  (:use))
diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index ce55d27..87d81ad 100644
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -3,6 +3,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; literals
 (defmacro defpsliteral (name string)
+  (pushnew name *ps-literals*)
   `(define-ps-special-form ,name (expecting)
     (declare (ignore expecting))
     (list 'js-literal ,string)))
@@ -316,7 +317,7 @@ the given lambda-list and body."
            (rest-form
             (if rest?
                 (with-ps-gensyms (i)
-                  `(progn (defvar ,rest array)
+                  `(progn (var ,rest (array))
                     (dotimes (,i (- arguments.length ,(length effective-args)))
                       (setf (aref ,rest ,i) (aref arguments (+ ,i ,(length effective-args)))))))
                 `(progn)))
diff --git a/t/package-system-tests.lisp b/t/package-system-tests.lisp
index 919408b..30c2b0f 100644
--- a/t/package-system-tests.lisp
+++ b/t/package-system-tests.lisp
@@ -44,7 +44,7 @@
 
 (test namespace1 ()
   (setf (ps-package-prefix "PSTSTPKG") "prefix_")
-  (is (string= "prefix_var;" (normalize-js-code (ps pststpkg::var)))))
+  (is (string= "prefix_foo;" (normalize-js-code (ps pststpkg::foo)))))
 
 (common-lisp:in-package "PSTSTPKG")
 
diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index bb95d48..5a9f0c7 100644
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -311,7 +311,7 @@ x = 2 + sideEffect() + x + 5;")
   "{ }")
 
 (test-ps-js blank-object-literal
-  {}
+  ({})
   "{ }")
 
 (test-ps-js defun-rest1
-- 
2.20.1