From 6d1a6f9c155aec6658140366179aab3f3bb10351 Mon Sep 17 00:00:00 2001
From: Bart Botta <00003b@gmail.com>
Date: Sun, 23 Nov 2008 20:42:22 -0600
Subject: [PATCH] add properties of user-defined classes to symbol table

---
 compile/compiler-context.lisp |  5 +++++
 compile/ffi.lisp              |  5 +----
 compile/swfclass.lisp         | 15 +++++++++------
 3 files changed, 15 insertions(+), 10 deletions(-)

diff --git a/compile/compiler-context.lisp b/compile/compiler-context.lisp
index 4aa5453..b26f2e3 100644
--- a/compile/compiler-context.lisp
+++ b/compile/compiler-context.lisp
@@ -45,6 +45,11 @@
          when (find-swf-property symbol i)
          return it)))
 
+(defun add-swf-property (symbol swf-name &optional (s *symbol-table*))
+  (pushnew swf-name
+           (gethash symbol (properties s) (list))
+           :test 'string=))
+
 (defun find-swf-function (symbol &optional (s *symbol-table*))
   (or (car (gethash symbol (functions s)))
       (loop for i in (inherited-symbol-tables s)
diff --git a/compile/ffi.lisp b/compile/ffi.lisp
index 3dab23b..3ed325d 100644
--- a/compile/ffi.lisp
+++ b/compile/ffi.lisp
@@ -27,10 +27,7 @@
           append (destructuring-bind (pname &key swf-name type access declared-by) i
                      (declare (ignore access type))
                      (if (eql declared-by class-name)
-                         `((pushnew ,swf-name
-                                    (gethash ',pname (properties *symbol-table*)
-                                             (list))
-                                    :test 'string=))
+                         `(add-swf-property ,swf-name ',pname)
                          nil)))
      ;; store methods
      ,@(loop for i in methods
diff --git a/compile/swfclass.lisp b/compile/swfclass.lisp
index d3049f5..d657314 100644
--- a/compile/swfclass.lisp
+++ b/compile/swfclass.lisp
@@ -3,9 +3,12 @@
 ;;;; code for defining vm level classes
 
 (defmacro def-swf-class (name ns super (&rest properties) ((&rest constructor-args) &body constructor))
-  `(setf (gethash ',name (classes *symbol-table*))
-         (list ',(avm2-asm::symbol-to-qname-list name)
-               ',ns
-               ',super
-               ',properties
-               (list ',constructor-args ',constructor))))
+  `(progn
+     (setf (gethash ',name (classes *symbol-table*))
+          (list ',(avm2-asm::symbol-to-qname-list name)
+                ',ns
+                ',super
+                ',properties
+                (list ',constructor-args ',constructor)))
+     ,@(loop for p in properties
+          collect `(add-swf-property ',p ',p))))
-- 
2.11.4.GIT