compile/compiler-context.lisp

   1 (in-package :as3-compiler)
   2
   3 ;;; copied from old code, not used yet...
   4
   5 #+nil
   6 (defclass symbol-table ()
   7   ((variables :initform (make-hash-table) :accessor variables)
   8    (properties :initform (make-hash-table) :accessor properties)
   9    ;; not sure if constants work the same as properties yet, so
  10    ;; keeping separate for now
  11    ;; (static-properties might be a better name, if they are separate?)
  12    (constants :initform (make-hash-table) :accessor constants)
  13    (class-methods :initform (make-hash-table) :accessor class-methods)
  14    (classes :initform (make-hash-table) :accessor classes)))
  15
  16 #+nil
  17 (defparameter *player-symbol-table* (make-instance 'symbol-table))
  18
  19 #+nil
  20 (defparameter *symbol-table* (make-instance 'symbol-table))
  21
  22 #+nil
  23 (defmacro declare-swf-class (name super &body _ &key swf-name constants properties methods)
  24   (declare (ignore super _))
  25   ;(format t "props = ~a ~%" properties)
  26   ;(format t "name = ~s  ~s eql=~s ~%" name (car (last (car properties))) (eql name (car (last (car properties)))))
  27   `(progn
  28      ;; using the old player-classes.lisp stuff for super for now, so
  29      ;; ignoring it...
  30
  31      ;; store class name
  32      (setf (gethash ',name (classes *symbol-table*)) ,swf-name)
  33      ;; store constants
  34      ,@(loop for i in constants
  35           collect (destructuring-bind (name &key swf-name type) i
  36                     (declare (ignore type))
  37                       `(pushnew ,swf-name
  38                                 (gethash ',name (constants *symbol-table*)
  39                                          (list))
  40                                  :test 'string=)))
  41      ;; store properties
  42      ,@(loop for i in properties
  43           append (destructuring-bind (pname &key swf-name type access declared-by) i
  44                      (declare (ignore access type))
  45                      (if (eql declared-by name)
  46                          `((pushnew ,swf-name
  47                                     (gethash ',pname (properties *symbol-table*)
  48                                              (list))
  49                                     :test 'string=))
  50                          nil)))
  51      ;; store methods
  52      ,@(loop for i in methods
  53           append (destructuring-bind (mname &key swf-name return-type
  54                                            declared-by args) i
  55                      (declare (ignore args return-type))
  56                      (if (eql declared-by name)
  57                          `((pushnew ,swf-name
  58                                     (gethash ',mname
  59                                              (class-methods *symbol-table*)
  60                                              (list))
  61                                     :test 'string=))
  62                          nil)))))