clsr/gcc-xml-ffi/src/gcc-xml-parse.cl

   1
   2 (in-package :gcc-xml-ffi)
   3
   4 (defun parse-gcc-xml-file (f)
   5   (with-open-file (xmlin f)
   6     (let ((xml (xmls::parse xmlin)))
   7       (destructuring-bind (tag attrs &rest elements)
   8           xml
   9         (declare (ignore attrs))
  10         (when (string-equal (string-downcase tag) "gcc_xml")
  11           (let ((decls (make-instance 'c-declaration-set)))
  12             (dolist (e elements) (do-gcc-xml e decls))
  13             decls))))))
  14
  15 (defun do-gcc-xml (sexp decls)
  16   (cond ((listp sexp)
  17          (destructuring-bind (tag attrs &rest elements)
  18              sexp
  19            (let* ((key (intern (string-upcase tag) :keyword))
  20                   (obj
  21                    (case key
  22                      (:namespace
  23                       (let ((ns (do-namespace attrs elements)))
  24                         (setf (gethash (id ns) (c-namespaces decls)) ns)))
  25                      (:function
  26                       (let ((func (do-function attrs elements)))
  27                         (setf (gethash (id func) (c-functions decls)) func)))
  28                      (:functiontype
  29                       (let ((functype (do-function-type attrs elements)))
  30                         (setf (gethash (id functype) (c-function-types decls)) functype)))
  31                      (:enumeration
  32                       (let ((enum (do-enumeration attrs elements)))
  33                         (setf (gethash (id enum) (c-enumerations decls)) enum)))
  34                      (:typedef
  35                       (let ((tdef (do-typedef attrs elements)))
  36                         (setf (gethash (id tdef) (c-typedefs decls)) tdef)))
  37                      (:fundamentaltype
  38                       (let ((tdef (do-fundamental-type attrs elements)))
  39                         (setf (gethash (id tdef) (c-fundamental-types decls)) tdef)))
  40                      (:pointertype
  41                       (let ((tdef (do-pointer-type attrs elements)))
  42                         (setf (gethash (id tdef) (c-pointer-types decls)) tdef)))
  43                      (:cvqualifiedtype
  44                       (let ((tdef (do-cv-qualified-type attrs elements)))
  45                         (setf (gethash (id tdef) (c-cv-qualified-types decls)) tdef)))
  46                      (:referencetype
  47                       (let ((tdef (do-reference-type attrs elements)))
  48                         (setf (gethash (id tdef) (c-reference-types decls)) tdef)))
  49                      (:struct
  50                       (let ((struct (do-struct attrs elements)))
  51                         (setf (gethash (id struct) (c-structs decls)) struct)))
  52                      (:union
  53                       (let ((union (do-union attrs elements)))
  54                         (setf (gethash (id union) (c-unions decls)) union)))
  55                      (:field
  56                       (let ((field (do-field attrs elements)))
  57                         (setf (gethash (id field) (c-fields decls)) field)))
  58                      (:arraytype
  59                       (let ((arraytype (do-array-type attrs elements)))
  60                         (setf (gethash (id arraytype) (c-array-types decls)) arraytype)))
  61                      (:constructor
  62                       (let ((constructor (do-constructor attrs elements)))
  63                         (setf (gethash (id constructor) (c-constructors decls)) constructor)))
  64                      (:class
  65                       (let ((class (do-class attrs elements)))
  66                         (setf (gethash (id class) (c-classes decls)) class)))
  67                      (:variable
  68                       (let ((variable (do-variable attrs elements)))
  69                         (setf (gethash (id variable) (c-variables decls)) variable)))
  70                      )))
  71              (when (and obj (id obj))
  72                (setf (gethash (id obj) (c-ids decls)) obj)))))))
  73