Changeset 13764


Ignore:
Timestamp:
01/11/12 21:17:23 (9 years ago)
Author:
astalla
Message:

More value types for primitive annotation elements.
Syntax sugar for annotations in runtime-class.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

    r13755 r13764  
    13651365                                               (primitive-or-string-annotation-element-value self)
    13661366                                               (pool-add-int (class-file-constants class) (if value 1 0))))
     1367                                        (character
     1368                                         (setf (annotation-element-tag self)
     1369                                               (char-code #\C)
     1370                                               (primitive-or-string-annotation-element-value self)
     1371                                               (pool-add-int (class-file-constants class) (char-code value))))
    13671372                                        (fixnum
    13681373                                         (setf (annotation-element-tag self)
     
    13701375                                               (primitive-or-string-annotation-element-value self)
    13711376                                               (pool-add-int (class-file-constants class) value)))
     1377                                        (integer
     1378                                         (setf (annotation-element-tag self)
     1379                                               (char-code #\J)
     1380                                               (primitive-or-string-annotation-element-value self)
     1381                                               (pool-add-long (class-file-constants class) value)))
     1382                                        (double-float
     1383                                         (setf (annotation-element-tag self)
     1384                                               (char-code #\D)
     1385                                               (primitive-or-string-annotation-element-value self)
     1386                                               (pool-add-double (class-file-constants class) value)))
     1387                                        (single-float
     1388                                         (setf (annotation-element-tag self)
     1389                                               (char-code #\F)
     1390                                               (primitive-or-string-annotation-element-value self)
     1391                                               (pool-add-float (class-file-constants class) value)))
    13721392                                        (string
    13731393                                         (setf (annotation-element-tag self)
  • trunk/abcl/src/org/armedbear/lisp/runtime-class.lisp

    r13755 r13764  
    133133
    134134(defun parse-annotation (annotation)
    135   annotation) ;;TODO
     135  (when (annotation-p annotation)
     136    (return-from parse-annotation annotation))
     137  (destructuring-bind (class &rest elements) (if (listp annotation) annotation (list annotation))
     138    (let (actual-elements)
     139      (dolist (elem elements)
     140        (push (parse-annotation-element elem) actual-elements))
     141      (make-annotation :type class :elements (nreverse actual-elements)))))
     142
     143(defun parse-annotation-element (elem)
     144  (cond
     145    ((annotation-element-p elem) elem)
     146    ((atom elem) (make-primitive-or-string-annotation-element :name nil :value elem))
     147    ((keywordp (car elem)) (parse-annotation-element `("value" ,@elem)))
     148    (t
     149     (destructuring-bind (name &key value enum annotation) elem
     150       (cond
     151         (enum (make-enum-value-annotation-element :name name :type enum :value value))
     152         (annotation
     153          (make-annotation-value-annotation-element :name name :value (parse-annotation annotation)))
     154         ((listp value)
     155          (make-array-annotation-element :name name :values (mapcar #'parse-annotation-element value)))
     156         (t (make-primitive-or-string-annotation-element :name name :value value)))))))
    136157
    137158#+example
     
    142163           (list "foo" :void '("java.lang.Object")
    143164                 (lambda (this that) (print (list this that)))
    144                  :annotations (list (make-annotation :type "java.lang.Deprecated")
    145                                     (make-annotation :type "java.lang.annotation.Retention"
    146                                                      :elements (list (make-enum-value-annotation-element
    147                                                                       :type "java.lang.annotation.RetentionPolicy"
    148                                                                       :value "RUNTIME")))
    149                                     (make-annotation :type "javax.xml.bind.annotation.XmlAttribute"
    150                                                      :elements (list (make-primitive-or-string-annotation-element
    151                                                                       :name "required"
    152                                                                       :value t)))))
     165                 :annotations (list "java.lang.Deprecated"
     166                                    '("java.lang.annotation.Retention"
     167                                      (:enum "java.lang.annotation.RetentionPolicy" :value "RUNTIME"))
     168                                    '("javax.xml.bind.annotation.XmlAttribute" ("required" :value t))
     169                                    '("com.manydesigns.portofino.system.model.users.annotations.RequiresPermissions"
     170                                      ("level"
     171                                       :enum "com.manydesigns.portofino.model.pages.AccessLevel"
     172                                       :value "EDIT")
     173                                      ("permissions" :value ("foo" "bar")))))
    153174           (list "bar" :int '("java.lang.Object")
    154175                 (lambda (this that) (print (list this that)) 23))))
Note: See TracChangeset for help on using the changeset viewer.